;;; Copyright (c) 1999 Massachusetts Institute of Technology
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, see https://gnu.org/licenses or
;;; write to:
;;;  Free Software Foundatiom, Inc.
;;;  51 Franklin St, Fifth Floor
;;;  Boston, MA 02110-1301
;;;  USA


;;; CORE JOB

SUBTTL CORE ALLOCATOR - USER ROUTINES
;
;  USER ROUTINES (TO COMMUNICATE WITH CORE JOB)
;
UACORE:	;U HAS INDEX CORE REQUEST IS FOR
ACORE:	CAILE B,400
	 POPJ P,
	MOVE Q,U	;USER TO MAKE CORE FOR
ACORE1:	PUSH P,U
	MOVE U,USER
	PUSHJ P,ACRF1
	 SKIPA
	  AOS -1(P)
	POP P,U
	POPJ P,

;EXCESSIVE CORE REQUEST CHECK
ACRTST:	CAILE B,400
	 POPJ P,
	JRST POPJ1
;CORTYP SYSTEM CALL.
;IF 2 ARGS,1ST ARG IS JOB SPEC, LIKE CORBLK'S 2ND AND 4TH ARGS.
;2ND ARG IS PAGE NUMBER IN THAT JOB.
;IF ONLY 1 ARG, IT IS THE PAGE NUMBER IN THE EXECUTING JOB.
;RETURNED VALUES:
;1ST VALUE BITS:
;	%CBWRT	;4.9 PAGE IS WRITEABLE
;	%CBRED	;4.8 PAGE IS READABLE (EXISTS)
;	%CBPUB	;4.6 PAGE IS PUBLIC
;	%CBLOK	;4.2 PAGE IS LOCKED IN CORE
;	%CBSLO	;3.9 PAGE IS IN SLOW MEMORY
;	FOR NON EX PAGE, ALL THE REST ARE 0.
;2ND IS 0 => PAGE IS ABSOLUTE, -1 => UNSHARED,
;	ELSE IS JOB NUMBER OF NEXT JOB IN CIRCULAR LIST.
;3RD IF ABSOLUTE PAGE, HAS PAGE NUMBER.
;	IF PAGE IS SHARED, HAS PAGE NUMBER IN THE JOB
;	WHOSE NUMBER IS THE 2ND VALUE. ELSE, 0.
;4TH BIT 4.9 => PAGE IS IN CORE.
;    RH IS NUMBER OF TIMES PAGE IS SHARED
;	(WILL BE 0 FOR ABS PAGE OR IF NO PAGE,
;	 OTHERWISE WILL BE >= 1)

NCORTY:	PUSHJ P,SWTL	;DON'T LET PAGE MAPS CHANGE.
	    CIRPSW
	SOSG W		;IF 1 ARG, USE -1 (SELF) FOR JOB SPEC.
	 SKIPA B,[-1]
	  EXCH A,B	;ELSE 1ST ARG IS JOB SPEC.
	MOVE J,B
	JSP T,NCRUI2	;DECODE THE JOB SPEC IN J,
	 JFCL		;RETURNS USR IDX IN J.
	TDNE A,[-400]
	 JRST OPNL33	;BAD PAGE NUM.
	PUSHJ P,NCORT0	;DO THE ACTUAL WORK.
	PUSHJ P,LSWPOP	;UNLOCK CIRPSW,
	JRST POPJ1	;GIVE VALUES TO USER, SKIP.

;CALL HERE FROM AUSET5  (ALWAYS COMES WITH CIRPSW LOCKED)
NCORT0:	PUSH P,U
IFN PDP6P,[
	CAIN J,-1
	 JRST [	SETZB B,D	;DON'T CALL UPLC IF PDP6, WOULD CRASH SYSTEM
		MOVEI C,PDP6BM_-12(A)
		CAIL A,LPDP6M
		 TDZA A,A
		  MOVSI A,%CBRED+%CBWRT
		JRST POPUJ ]
];PDP6P
	MOVEI U,(J)	;UPLC USES USER IN U.
	PUSHJ P,UPLC	;NOTE PAGE NUM IS IN A.
	LDB J,T		;GET PAGE'S HARDWARE HALFWD,
	LDB C,Q		;GET CIRC. LIST POINTER.
	JUMPE C,NCORTE	;J IF NO PAGE THERE.
	MOVEI A,(J)
	TRNE A,600000	;GET ACCESS INTO A 1.1-1.2
	 LDB A,[200200,,A]
	CAIN A,2	;CHANGE READ-WRITE-FIRST TO READ-WRITE.
	 MOVEI A,3
	ROT A,-2	;SHIFT INTO 4.8-4.9
	CAIN C,-1
	 JRST NCORTA	;J IF ABSOLUTE PAGE(CIRC PTR -1)
	PUSHJ P,CHACK	;PG MUST HAVE REAL CIRC LIST, TRACE IT.
	EXCH C,D	;D HAD MMP IDX; C HAD IN-CORE,,LIST LENGTH.
	ADD C,MMPEAD
	SKIPGE C,(C)	.SEE MMPPUB
	 TLO A,%CBPUB
	TLNE C,MMPLOK
	 TLO A,%CBLOK
	TLNE C,MMPSLO
	 TLO A,%CBSLO
	SUBI D,1	;LIST LENGTH COUNTS THE MMP ENTRY,
	SKIPGE D
	SUBI D,1	;COUNTS THE MEMBLT ENTRY IF PAGE IN CORE.
	TRNN D,-2	;RH NOW HAS # SHARERS,
	 JRST NCORTS	;ONLY 1 => PAGE NOT SHARED.
	MOVE C,Q
	MOVE B,P
	PUSHJ P,UCPRL	;>1 SHARER => FIND NEXT SHARER,
	 400000,,.+1
	MOVE P,B	;UN-SCREW STACK (UCPRL PUSHJ'D BACK)
	LDB B,[101100,,T]
	MOVE C,I	;2ND, 3RD VALUES USR NUM & PAGE NUM
	JRST POPUJ	;OF THE NEXT SHARER.

;COME HERE IF NO PAGE WITH THAT PAGE NUM.
NCORTE:	SETZB A,B
	SETZB C,D	;RETURN ALL ZEROS.
	JRST POPUJ

;COME HERE IF ABS PAGE, ACCESS ALREADY IN A.
NCORTA:	SETZB B,D	;JOB # 0 (SYS JOB) FOR ABS PAGE.
	LDB C,[PMRCAD,,J]	;GET ABS PAGE NUM FROM HARDWARE HALFWD.
	JRST POPUJ

;COME HERE IF UNSHARED NORMAL PAGE.
;ACCESS ALREADY IN A, 4TH VALUE IN D.
NCORTS:	SETO B,		;2ND VALUE -1 FOR UNSHARED.
	SETZ C,
	JRST POPUJ

;CORBLK CALL
;1ST ARG FLAG BITS: (RH XOR'D INTO LH BEFORE DECODING)

%CB==0,,525252
%CBWRT==400000	; 4.9 GET WRITE ACCESS IF OK, DON'T FAIL IF NOT.
%CBRED==200000	; 4.8 GET READ ACCESS
%CBNDW==100000	; 4.7 GET WRITE ACCESS, FAIL IF CAN'T.
%CBPUB==40000	; 4.6 MAKE PAGE PUBLIC
%CBPRV==20000	; 4.5 MAKE IT PRIVATE (BOTH FAIL IF COULDN'T GET WRITE ACCESS)
%CBNDR==10000	; 4.4 FAIL IF CAN'T GET READ ACCESS.(COPYING NONEXISTANT PAGE)
%CBCPY==4000	; 4.3 MAKE COPY (CURRENTLY ONLY IMPLEMENTED FOR PAGE OF FILE)
%CBLOK==2000	; 4.2 LOCK PAGE IN CORE.
%CBULK==1000	; 4.1 UNLOCK PAGE (ALLOW SWAP-OUT)
%CBSLO==400	; 3.9 MAY ONLY RESIDE IN SLOWEST MEMORY
%CBUSL==200	; 3.8 ALLOWS USE OF ANY MEMORY.
		;IF ALL 0, DELETE.

%CBNWP==563600	;BITS THAT NEED WRITE-PERMISSION.

;2ND ARG SPECIFIES JOB TO PUT PAGE IN
;   IS EITHER CHNL NUM, -1 FOR SELF, OR 400000+USRNUM
;JOB SPECIFIED MUST BE CURRENT JOB OR INFERIOR.

;3RD ARG RH. IS PAGE NUM. IN IT.
; LH. IF NEGATIVE, BLOCK MODE, REPEAT THAT MANY TIMES,
;   INCREMENTING BOTH PAGE NUMS EACH TIME.
;IN BLOCK MODE, REWRITES 3RD AND 5TH ARGS EACH TIME.

;4TH ARG IS SOURCE OF PAGE,
; A DISK CHANNEL NUMBER (GET N'TH PAGE IN FILE), OR
; A <JOB> SPEC:
;  A USR, JOB, BOJ, OR STY CHANNEL NUMBER
;  OR ONE OF THE FOLLOWING SPECIAL CODES:
%JS==,-1
%JSNUM==400000	;400000+JOB NUMBER => THAT JOB
%JSSUP==400377	;CURRENT JOB'S SUPERIOR
%JSELF==,,-1	;SELF
%JSTVB==,,-2	;TV11 VIDEO BUFFER IN FIRST 8 PAGES, 1ST WD OF 9TH PG IS CONSOLE REG
%JSNUL==,,-3	;NULL JOB (NOT VALID FOR CORBLK)
%JSALL==,,-4	;ALL JOBS (NOT VALID FOR CORBLK)
%JSNEW==,,-5	;FRESH PAGE
%JSABS==,,-6	;ABSOLUTE PAGE (PHYSICAL MEMORY)
;  JOB 0 = SYSTEM JOB = EXEC VIRTUAL ADDRESS SPACE
;  JOB 1 = CORE JOB = FRESH PAGE (OBSOLESCENT, USE %JSNEW, EVENTUALLY WILL GO AWAY)
;IF NO 4TH ARG, SAME AS 2ND

;5TH ARG IS PAGE NUM IN SOURCE (IGNORED FOR FRESH PAGE)
;IF NO 5TH ARG, SAME AS 3RD IF 4TH ARG SPECIFIES JOB.

;IF 4TH ARG SPECS FILE, USE CURRENT ACCESS PNTR
;IF INSERTING DISK PAGES, THE ACCESS PTR WILL BE
;POSITIONED AT THE BEGINNING OF THE PAGE AFTER THE LAST PAGE INSERTED.

;BITS IN REGS R AND I:
NCOR$P==400000	;SOURCE USER ISN'T WRITEABLE. PAGES ARE, IFF PUBLIC.
NCOR$Q==200000	;SOURCE IS A DISK FILE.

;CORBLK - COMMENTS ON PRECEDING PAGE.
NCORBL:	TSC A,CTLBTS(U)
	TLC A,(A)	;WIN FOR IMMEDIATE FIRST ARG
	HRRZM C,SRN3(U)	;SAVE PTRS TO 3RD, 5TH ARGS IN SRN3, SRN4 RESPECTIVELY
	TLNE C,1000
	 TLZA C,-1
	UMOVE C,(C)
	SKIPGE C	;IF WILL REWRITE,CHECK FOR PURE
	 XCTR XRW,[MOVES @SRN3(U)]
	HRRZM E,SRN4(U)
	CAIGE W,5	;BUT IF NO 5TH ARG, SAY SO & USE 3RD.
	 JRST NCORB1	;DEFAULT E TO C,SETOM SRN4
	TLNN E,1000	;IMMEDIATE 5TH ARG LEGAL
	 JRST NCORB8
	JUMPGE C,NCORB7	;ONLY IF WON'T HAVE TO REWRITE IT
	JRST OPNL33

NCORB1:	SETOM SRN4(U)
	MOVE E,C
	JRST NCORB7

NCORB8:	UMOVE E,(E)
	SKIPGE C
	 XCTR XRW,[MOVES @SRN4(U)]
NCORB7:	ANDI E,-1
	MOVE J,B
	JSP T,NCRUI1	;GET USER INDEX OF TARGET.
	 JRST NCORB0	;IF DOESN'T SKIP, CAN CERTAINLY WRITE.
	CAIE J,-1	;CAN'T STICK PAGE IN 6.
	 JSP T,NCORWR	;ELSE CHECK.
	  JRST OPNL31	;CANT WRITE SO CANT STICK PAGE IN
NCORB0:	MOVEI TT,(J)	;SAVE DEST. USER IDX.
	CAIN TT,(U)	;IF NOT ACTING ON SELF, PCLSR TARGET JOB.
	 JRST NCORC1
	EXCH A,TT
	PUSHJ P,RPCLSR
	PUSHJ P,LSWPOP	;SOS DIELOK(A)
	MOVEM A,SRN5(U)
	MOVSI T,BSSTP	;BUT LEAVE BSSTP SET INSTEAD OF RH
	IORM T,USTP(A)
	SOS USTP(A)	;BECAUSE CORE JOB WANTS RH TO BE CLEAR
	EXCH A,TT
	PUSHJ P,LOSSET	;UNDO SETTING OF BSSTP IF WE PCLSR OR FAIL
	    NCORFS
	CAIA
NCORC1:	 PUSHJ P,LSWPOP	;SOS DIELOK(TT)
;DROPS THROUGH.

;DROPS THROUGH. ALSO COME HERE FROM ACBLK.
;TARGET DECODED AND STOPPED IF NEC.; USER IDX IN TT.
; NOW DECODE SOURCE IF NEC.
NCORB9:	PUSHJ P,SWTL
	    CIRPSW
	TLNE A,%CBNDW	;FORCE WRITE => WRITE.
	 TLO A,%CBWRT
	JUMPE A,NCORD	;0 ACCESS WANTED => DELETE PAGES.
	TLO A,%CBRED	;NOT DELETE, WANT AT LEAST READ ACCESS.
	CAIGE W,4	;IF HAD 4TH ARG, DECODE,
	 JRST NCORC2	;ELSE USE DECODED 2ND (STILL IN J).
	HRRZ J,D
	CAIE J,%JSNEW
	 CAIN J,%JSABS
	  JRST NCORC2	;SPECIAL NON-JOB SOURCE, SKIP DECODE
IFN N11TYS,[
	CAIN J,%JSTVB
	 JRST [	SKIPN TEN11F	;TV11 SOURCE
		 SKIPL TT11P
		  JRST OPNL10	;DEVICE NOT AVAIL
		JRST NCORC2]
]
	MOVE J,D
	JSP T,NCRUI1	;GET SOURCE USR IDX
	 JRST NCORB2
	  JRST NCORC0
	TLNN H,%CLSQ	;COME HERE IF ARG IS RANDOM IO CHANNEL.
	 JRST OPNL34	;NOT DSK => NO GOOD.
	MOVE R,J	;2 SKIPS => DISK CHNL; PUT ITS # IN R.
	TLO R,NCOR$Q	;INDICATE DISK CHNL
	MOVSI T,%QAACC
	TDNE T,QSRAC(R)	;INSURE THAT %QAACC WILL BE ON IF OUR
	 JRST NCORQD
	IORM T,QSRAC(R)	;CALL TO QFNTR FINDS EOF.
	MOVE T,QFBLNO(R) ;IF %QAACC WAS 0, THEN QRADAD ISN'T SET UP.
	MOVEM T,QRADAD(R)
NCORQD:	SETOM NCORQC	;1ST TIME THRU NCORL LOOP COMING UP.
	CAIGE W,5
	 JRST NCORL
	MOVE T,E	;DON'T SMASH E, WILL BE WRITTEN BACK TO USER
	LSH T,10.	;5TH ARG GIVES PAGE ADDRESS IN FILE FOR DISK CHNL
	IMULI T,@QSBYTE(R)
	MOVEM T,QRADAD(R) ;SET ACCESS PTR OF DSK CHNL -> SPEC'D PAGE.
	JRST NCORL

NCORC0:	TLNN A,%CBNWP	;IF REQUIRE ALTERATION,
	 JRST NCORB2
	JSP T,NCORW1	;IF CAN'T WRITE THAT JOB,
	HRLI J,NCOR$P	;SET FLAG TO CHECK FOR PUBLIC.
NCORB2:	CAIE J,-1	;IF NOT PDP6,
	 PUSHJ P,LSWPOP	;SOS DIELOK(J)
	CAIN J,LUBLK	;IF SOURCE IS CORE JOB  (EVENTUALLY DELETE THESE TWO LINES)
	 MOVEI J,%JSNEW	; THAT MEANS GET FRESH PAGE
NCORC2:	MOVE R,J
	CAIN R,%JSNEW	;FRESH PAGE IMPLIES WRITING
	 TLO A,%CBNDW+%CBWRT

;DROPS THROUGH

;DROPS IN

;NOW HAVE TARGET IDX IN TT, SOURCE IN R (USER INDEX, -1 FOR
; PDP6, %JSTVB, %JSNEW, OR %JSABS).
;TARGET PAGNUM IN C; SOURCE IN E (MAYBE INVALID).
;R 4.9 => WRITE REQUIRES PUBLIC PAGE.
;R 4.8 => R HAS DISK CHNL (AND NCORQC IS -1 THE 1ST TIME AROUND)
;DECIDE WHAT KIND PAGE WANTED AND FIND IT.
;CIRPSW MUST BE ON TOP OF LSWPR. IT WILL BE
;UNLOCKED EVENTUALLY (AND ALSO 1 MORE UNDERNEATH IT
;IF THE TARGET JOB ISN'T US). FAILURE DOES A LSWCLR.
NCORL:	MOVEI I,(R)	;I WILL HAVE USR IDX FOR ACTUAL PAGE.
	HLRS A		;RH OF A WILL GET ACCESS TO BE GRANTED.
	TRNE C,-400	;CHECK DEST PAGE NUM IN RANGE.
	 JRST OPNL33

	PUSH P,U
	PUSH P,C
	TLNE R,NCOR$Q
	 JRST NCORQ1	;DISK FILE
IFN PDP6P,[
	CAIN I,-1
	 JRST NCORE4	;-1 => PDP6 PAGE.
]
IFN N11TYS,[
	CAIN I,%JSTVB
	 JRST NCORV1	;TV11
]
	CAIN I,%JSNEW
	 JRST NCORF0	;FRESH PAGE.
	CAIN I,%JSABS
	 JRST NCORE1	;ABSOLUTE PAGE.
	CAIL E,400
	 JRST NCORE7	;ELSE SOURCE PAGNUM MUST BE < 400
	MOVEI U,(R)	;SOURCE IS A USER
NCORF2:	EXCH E,A	;GET SOURCE PAGNUM IN A
	PUSHJ P,UPLC;(A,U)	;FIND THE PAGE WANTED.
	EXCH E,A
	LDB J,Q		;UPLC RETURNS IN T,Q.
	JUMPE J,NCORE6	;FAIL OR DELETE IF HE HAS NO PAGE THERE.
	CAIN J,-1
	 JRST NCORE5	;IF THAT PAGE IS ABS,CHANGE TO ABS REQ.
	PUSHJ P,CHACK	;A REAL PAGE, FIND MMP, PREV. PTR.
	ADD D,MMPEAD
	MOVE B,Q
	MOVEI I,(R)	;CHACK CLOBBERS I
	TLNN A,%CBNDW+%CBWRT	;IF WANTED ALTERATION, CHECK LEGAL.
	 JRST NCORB3
	LDB J,T		;1ST OF ALL, SOURCE MUST HAVE WRITE PERM.
	TRNN J,600000
	 LSH J,20
	TRNN J,400000
	 JRST NCORB5
	CAIN R,%JSNEW
	 JRST NCORF3
NCORF4:	CONO PI,UTCOFF	;DSK XFER COULD COMPLETE, CHANGING INTRANSIT BIT
	MOVE J,(D)	; HE HAS WRITE PERM.; GET MMP IN J.
	TLNE R,NCOR$P	; CAN'T ALTER IF NEEDED PUBLIC BUT IT ISN'T.
	 JUMPGE J,[	CONO PI,UTCON	.SEE MMPPUB
			JRST NCORB5]
	TLNE A,%CBPUB	;WE CAN ALTER; CHANGE PUBLIC IF REQ.
	 TLO J,MMPPUB
	TLNE A,%CBPRV
	 TLZ J,MMPPUB
	TLNE A,%CBLOK
	 TLO J,MMPLOK
	TLNE A,%CBULK
	 TLZ J,MMPLOK
	TLNE A,%CBSLO
	 TLO J,MMPSLO
	TLNE A,%CBUSL
	 TLZ J,MMPSLO
	MOVEM J,(D)
	CONO PI,UTCON
	JRST NCORB3

NCORF0:	MOVEI U,(TT)	;WHEN CREATING A FRESH PAGE, HAVE TO RE-USE A PREVIOUSLY
	MOVEI E,(C)	;EXISTING PAGE IF POSSIBLE, BECAUSE AFTER THE FRESH PAGE
	JRST NCORF2	;IS GIVEN, USER WILL BE PCLSR'ED AND WILL COME IN AGAIN
			;LOOKING FOR A FRESH PAGE.  CURRENTLY THIS CAUSES A BUG
			;THAT A "FRESH PAGE" IS NOT ALWAYS ZERO.

NCORF3:	CAIE C,2	;WANT FRESH PAGE
	 CAMN C,[SETZ 3]
	  JRST .+2
	   JRST NCORD0	;SHARED PAGE CAN'T SERVE AS FRESH PAGE
	MOVEI I,(TT)
	JRST NCORF4

;COME HERE IF REQ WRITE ON REAL PAGE BUT CAN'T GRANT.
NCORB5:	CAIN R,%JSNEW
	 JRST NCORD0	;JUST REPLACE WITH FRESH PAGE
	TLNE A,%CBNDW+%CBPUB+%CBPRV+%CBSLO+%CBUSL+%CBLOK+%CBULK	;IF HE INSISTED, FAIL.
	 JRST NCORE0
	TRZ A,%CBWRT	;ELSE GIVE HIM ONLY READ PERM.
;COME HERE IF PAGE EXISTS TO GIVE ACCESS AS IN A 2.8,2.9
NCORB3:	HRRZ J,(P)
	CAIN TT,(I)	;ARE WE REPLACING PAGE BY ITSELF?
	 CAME E,J
	  JRST NCORD0	;NO, DELETE OLD, INSERT NEW.
	LDB J,T		;REPLACING PG W/ SELF, SET ACCESS & EXIT.
	TRNN J,600000
	 JRST NCORI1
	TRNN J,400000	;CHANGE READ TO RWF
	 TRC J,600000
	TRNE A,%CBWRT
	 JRST NCORI2
	MOVSI I,40000
	TROE J,200000
	 ANDCAM I,(D)
	TRZ J,400000
	JRST NCORI2

NCORI1:	MOVEI J,1
	TRNE A,%CBWRT
	 TRO J,2
NCORI2:	DPB J,T
	POP P,C
	POP P,U
	JRST NCORX	;TO END OF LOOP.

NCORQ1:	PUSH P,A
	PUSH P,TT
	PUSH P,R
	MOVEI A,(R)
	AOSN NCORQC	;THE 1ST TIME AROUND LOOP?
	 JRST NCORQ0	;YES, ACCESS TO 1ST PAGE TO BE INSERTED.
	PUSHJ P,QFNTN	;NO, JUST MOVE FORWARD 1 PAGE
	 JRST NCORE8	;REACHED EOF, CAN'T INSERT PAGE
NCORQF:	POP P,R
	POP P,TT
	POP P,A
	MOVE I,R	;FOUND THE PAGE, GO INSERT IT.
	JRST NCORD0

NCORQ0:	MOVE Q,QRADAD(A)
	PUSHJ P,QFNTR
	 JRST NCORE8
	PUSHJ P,QUDULK	;QFNTR LEAVES IT LOCKED
	AOS QSLGL(A)	;DON'T BE FOOLED BY QFNTR'S TRICK
	SOS QSBI(A)	;ON THE DISK PI RTNS.
	JRST NCORQF

NCORE8:	POP P,R
	POP P,TT
	POP P,A
NCORE6:	CAIN R,%JSNEW	;COPY NONEXISTANT PAGE
	 JRST NCORD0	;JUST PUT IN A FRESH PAGE
	HRRI A,0	;CHANGE TO DELETE RQ.
	TLNN A,%CBNDR+%CBNDW+%CBPUB+%CBPRV+%CBLOK+%CBULK+%CBSLO+%CBUSL
	 JRST NCORD0	;IF INSIST ON ACCESS, FAIL.
NCORE0:	PUSHJ P,OPNL32	;CAN'T GRANT ACCESS OPNL.
POPCUJ:	POP P,C		;FAIL OUT OF CALL.
	JRST POPUJ

IFN PDP6P,[
;REQ FOR PDP6 PAGE.
NCORE4:	CAIL E,LPDP6M
	 JRST NCORE7	;OUT OF RANGE.
	MOVEI B,PDP6BM_<-10.>(E)
	JRST NCORE3	;CONVERT TO ABS REQ, WRITE OK
]

IFN N11TYS,[
;REQ FOR TV11 PAGE.
NCORV1:	CAIL E,NTVBP
	 JRST NCORE7
	SKIPL TVCREG(TT)	;IF CONSOLE REGISTER NOT ALREADY SET UP
	 JRST NCORV2
	MOVE B,TVVBN(TT)	;INITIALIZE IT FROM BLINKER
	MOVEM B,TVCREG(TT)
	CAMN TT,USER
	 MOVEM B,400000+TTR10*2000	;INITIALIZE HARDWARE CONSOLE REGISTER.
NCORV2:	LDB B,TTCRT(E)	;GET MAP ENTRY OUT OF EXEUMP
	ANDI B,PMRCM	;MASK TO PAGE #
	JRST NCORE3	;CONVERT TO ABS REQ, WRITE OK
]
;REQ FOR ABS PAGE.
NCORE1:	MOVEI B,(E)
	CAIGE B,TSYSM
	 JRST NCORE2	;ACCESS AVAILABLE, READ ONLY
	JRST NCORE6	;CAN'T GET ACCESS TO PAGE.

NCORE7:	PUSHJ P,OPNL33	;BAD ARG OPNL.
	JRST POPCUJ

;PAGE TO COPY WAS AN ABS PAGE.
NCORE5:	CAIN R,%JSNEW
	 JRST NCORD0	;SUBSTITUTE A FRESH PAGE
	LDB B,T			;GET ABS PAGE NUM.
	TRZE B,400000		;IF HE HASN'T WRITE PERM.
	 JUMPGE R,NCORE3	;OR WE CAN'T WRITE IN HIM,
NCORE2:	TRZ A,%CBWRT		;CAN'T GET WRITE,
	TLNN A,%CBNDW		;FAIL IF INSIST.
NCORE3:	 TLNE A,%CBPUB+%CBPRV+%CBLOK+%CBULK+%CBSLO+%CBUSL
	  JRST NCORE0		;OR IF TRYING TO CHANGE PUBLICNESS.
	MOVE D,B		;GET JUST THE PAGE # (NOT THE ACCESS CODE)
	ANDI D,PMRCM		;TO INDEX INTO TABLES WITH.
IFN TEN11P,[
	LDB I,[.BP <PMRCM-377> D]	;GET MOBY #
	CAIE I,T11CPA_-18.
	 JRST NCORE9
	MOVE Q,D
	SUBI Q,<T11CPA_-18.>_8
	CAIL Q,256.
	 JRST 4,.
	SKIPN I,T11MP(Q)
	 JRST 4,.	;SHOULDNT HAVE ABS PNTR TO NOT SET UP PAGE
	AOJE I,NCOREA	;CONFLICT PAGE
	LDB I,[350500,,T11MP(Q)]
	CAIN I,37
	 JRST NCOREA	;USAGE COUNT FULL
	ADDI I,1
	DPB I,[350500,,T11MP(Q)]
	JRST NCOREA
NCORE9:]
IFN PDP6P,[
	CAIL D,PDP6BM_-10.	;IS ABS PAGE # WITHIN RANGE OF PDP6 PAGES?
	 CAIL D,PDP6BM_-10.+LPDP6M
	  JRST NCOREB
	SKIPL PDP6UP		;IF SO, ALLOW PAGE COPYING, IFF PDP6 IS UP.
	 JRST NCORE6
	JRST NCOREA

NCOREB:]
	CAIL D,TSYSM
	 JRST NCORE6	;DONT ALLOW POINTER TO PAGE ABOVE TOTAL SYSTEM MEMORY
	LDB I,[MUR,,MEMBLT(D)]
	CAIN I,MUHOLE	;DON'T GIVE ABS PAGE THAT IS NXM.
	 JRST NCORE6
NCOREA:	MOVEI I,%JSABS	;INDICATE ABS REQ.
	JRST NCORD0

EBLK
NCORQC:	0	;COUNTS PASSES THRU NCORL, IF SOURCE IS DISK FILE.
		;FORCES COMPLETE REPOSITIONING IN FILE THE 1ST TIME THRU.
BBLK

;THIS IS FOR DELETE RQS WHAT NCORL IS FOR INSERTS.
.SEE NCORL	;ABOUT CIRPSW, ACS, ETC.
		;ALSO SEE COMMENTS HALFWAY DOWN THIS PAGE.
NCORD:	TRNE C,-400
	 JRST OPNL33	;PAGE NUM. OUT OF RANGE.
	PUSH P,U
	PUSH P,C
NCORD0:	PUSH P,A	;COME IN HERE ON VALID INSERT RQ.
NCORD1:	MOVE U,TT
	HRRZ A,-1(P)
	PUSH P,T
	PUSH P,B
	PUSHJ P,UPLC	;SAVE TIME BY CHECKING WHETHER PAGE EXISTS.
	LDB B,T
	SKIPE B
	 PUSHJ P,PAGERT	;IT EXISTS; DELETE IT.
	POP P,B
	POP P,T
	POP P,A		;FLAG WORD
	POP P,C		;TARGET PAGNUM
	POP P,U
	TRNN A,%CBRED+%CBWRT	;IF NO ACCESS REQ, IS DELETE, THRU.
	 JRST NCORX
;RH. OF A HAS ACCESS TO GRANT.  LH(A) HAS ORIGINAL CONTROL BITS.
;IF I=%JSABS, ABS PAGE, NUM. IN B.
;IF I=%JSNEW, FRESH PAGE.
;IF 4.8 IN I SET, DISK PAGE POINTED TO BY CHNL IN I
;ELSE OLD PAGE, B IS BP -> CIRC LIST, T -> OLD ACCESS.
	PUSH P,C	;-3
	PUSH P,E	;-2
	PUSH P,TT	;-1
	PUSH P,A	;0
	TLNE I,NCOR$Q
	 JRST NCORQ2	;INSERT PAGE FROM FILE
	CAIN I,%JSABS
	 JRST NCORA	;GO INSERT ABS PAGE
	CAIE I,%JSNEW
	 JRST NCORR	;GO INSERT REAL PAGE.
	PUSH P,R
	LSH C,9		;INSERT FRESH PAGE.
	MOVEI Q,(TT)	;TARGET JOB
	IDIVI TT,LUBLK	;CLOBBERS I.
	IORI TT,400000(C)
	HRLI TT,204000
	TLNE A,%CBPUB	;MAYBE RQ PUBLIC
	 TLO TT,1000
	PUSHJ P,NACRFL	;PUT IN CORE RQ (FREES CIRPSW)
	 JRST NCORF1
	POP P,R
	PUSHJ P,SWTL
	    CIRPSW
	HRRZ E,-3(P)	;GET TARGET PAGE NUM
	JRST NCORR2

NCORF1:	SUB P,[5,,5]
	JRST OPNL37	;NO CORE OPNL.

;COME HERE IF NEED TO WAIT FOR CORE AVAILABLE FOR NEW MMP PAGE.
NCORQW:	PUSHJ P,LSWPOP	;UNLOCK TUT.
	PUSHJ P,LSWPOP	;AND CIRPSW, SO CORE JOB CAN OPERATE.
	MOVEI T,3	;WAIT TILL MEM HAS BEEN FREED BY CORE JOB.
	CAMLE T,LMEMFR
	 PUSHJ P,UFLS
	PUSHJ P,SWTL	;RE-LOCK CIRPSW
	 CIRPSW
	MOVE TT,(P)
	JRST NCORQB	;THEN RETRY, RELOCKING TUT.
;FIND OR CREATE MMP ENTRY FOR BLOCK <- DISK CHNL IN I.
;ACCESS TO GRANT IS IN A.
;RETURNS STUFF IN B,T ACCORDING TO COMMENT
;AFTER NCORD1 (IF NEW MMP, IT POINT TO SELF AND B -> IT)
NCORQ2:	PUSH P,R
	PUSH P,[NCORR3]	;RETURN TO NCORR3, SKIPPING UNLESS MMP FULL
	MOVE TT,A
	MOVE A,I
NCORQ7:	PUSH P,TT	;ENTRY FROM NLOAD
NCORQB:	MOVE I,QDSKN(A)
	MOVE W,QSLGL(A)
	HRL W,I
	PUSHJ P,QTLOCK
	TRNE TT,%CBCPY	;SPECIFIED COPY-ON-WRITE?
	 JRST NCORQ6	;GET FRESH COPY OF PAGE
	MOVE B,W	;ELSE TRY TO SHARE EXISTING COPY OF PAGE
	IDIVI B,SHRHSL	;LOOK UP IN SHAREABLE-PAGE HASH TABLE
	MOVEI B,SHRHSH-1(C)
NCORQ5:	HRRZ B,1(B)	;THREAD TO NEXT MMP ENTRY IN BUCKET
	JUMPE B,NCORQ6	;END OF LIST, DESIRED PAGE NOT FOUND
	HLRZ C,1(B)	;GET DISK ADDRESS OF THIS PAGE
	LDB R,[$MMPUN,,(B)]
	CAIN C,(W)
	 CAIE R,(I)
	  JRST NCORQ5	;NOT THE ONE WE WANT
	MOVEI R,(B)	;SET UP MMP IDX IN R
	SUB R,MMPEAD	;AS GMMPP RETURNS IT.
	PUSHJ P,QTULK	;TUT ALREADY AOS'ED.
	MOVSI T,MMPGON
	TDNE T,(B)
	 JRST [	MOVSI T,MMPTMP	;MMP ENTRY GOING AWAY.
		TDNE T,(B)	;IF DISK TRANSFER ALSO IN PROGRESS,
		 JRST NCRMMW	; GO WAIT FOR THINGS TO SETTLE WITH CIRPSW FREE.
		PUSH P,A
		PUSHJ P,RETMM4	;CLEAR PENDING FREEAGE
		POP P,A
		JRST NCORQB ]	;AND TRY AGAIN
	MOVEI C,-1
	HRRZ T,(B)	;GET CIRC PNTR OUT OF MMP ENTRY.
	CAIL T,600000	;SKIP IF DOESN'T POINT TO MEMORY
	 TDNE C,MMSWP-600000(T)	;SKIP IF IT'S A LOOSE PAGE
	  JRST NCORQ8
	HRRZ C,MEMPNT-600000(T)
	CAIE C,400000(R) ;SKIP IF NO USERS IN CIRCULAR LIST
	 JRST NCORQ8	;NOT REALLY LOOSE, USERS LINKED BUT NOT CONNECTED
	MOVEI C,0	;REMOVE FROM LOOSE PAGE LIST
	MOVE W,FLOOSP
NCORQ3:	MOVE TT,C	;TT PREDECESSOR
	SKIPN C,W	;W SUCCESSOR
	 JRST 4,.	;NOT IN LOOSE PAGE LIST?
	LDB W,[MLO,,MEMBLT(C)]
	CAIE C,-600000(T)
	 JRST NCORQ3
	SKIPE TT
	 DPB W,[MLO,,MEMBLT(TT)]
	SKIPN TT
	 MOVEM W,FLOOSP
	SKIPN W
	 MOVEM TT,LLOOSP
	SOSL NLOOSP
	 JRST NCORQ8
	JRST 4,.	;NLOOSP WAS TOO SMALL?

NCORQ6:	SOSGE MMPFR	;NEED TO CREATE NEW MMP ENTRY; COMMIT ONE
	 JRST [	AOS MMPFR	;MMP FULL
		JRST POPTTJ ]	;TAKE ERROR RETURN
	PUSHJ P,GMMPP	;GET FREE MMP ENTRY (CAN'T PCLSR AFTER THIS SUCCEEDS)
	 JRST NCORQW	;WAIT FOR MORE MEM
	PUSHJ P,QTAOS1	;AOS TUT FOR BLOCK (TUT ALREADY LOCKED)
	HRLZM W,1(TT)	;STORE DISK ADR
	MOVE D,R
	IOR D,[MMPOUT+MMPWOD,,400000]	;SWAPPED OUT, MMP POINTING TO SELF
	DPB I,[$MMPUN,,D]
	MOVE C,(P)	;A
	TRNE C,%CBCPY
	 TLCA D,MMPWOD+MMPISW	;COPYING, SO SET INITIAL-SWAPIN
	  JRST [ MOVE B,W	;NO COPYING, SO
		 IDIVI B,SHRHSL	;STICK INTO SHAREABLE-PAGE HASH TABLE
		 MOVE B,SHRHSH(C)
		 HRRM B,1(TT)
		 HRRZM TT,SHRHSH(C)
		 TLO D,MMPSHR	;FLAG MMP ENTRY AS IN SHRHSH TABLE
		 JRST .+1 ]
	MOVEM D,(TT)
	HRRZ B,TT
	AOS NPGSWO
NCORQ8:	MOVE T,[300,,[3]]
	HRLI B,2200
	AOS -1(P)	;SUCCESS RETURN
	JRST POPTTJ

NCORA:	MOVEI A,(C)
	MOVE U,TT	;INSERT ABS PAGE.
	PUSHJ P,UPLC	;FIND TARGET PAGE
	IOR B,(P)		;COMBINE ACCESS W/ PAGE NUM.
	TRZ B,PMAGEM\PMUNSD\PMCSHM
IFE KA10P,[
	TRNE B,PMRCM	;PAGE 0 NOT CACHED
	 IORI B,PMCSHM
]
	LDB D,T
	TRZ D,PMAGEM	;TURN OFF REMNANT AGE BITS
	JUMPN D,[JRST 4,.]	;SHOULD HAVE DELETED PAGE ALREADY
	DPB B,T
	MOVNI B,1	;CIRC. PTR. IS -1.
	DPB B,Q
	MOVEI E,(A)
	JRST NCORR2

 ;VIRTUAL PUSHJ AT NCORQ2
NCORR3:	 JRST [	SUB P,[5,,5]	;MMP WAS FULL
		JRST OPNL37 ]
	POP P,R		;COME HERE FOR DSK PG, AFTER FINDING MMP.
	MOVE C,QRADAD(A)	;MOVE ACCESS POINTER OF FILE TO
	IDIVI C,@QSBYTE(A)	;NEXT PAGE BOUNDARY, BEING CAREFUL
	IORI C,1777		;ABOUT BYTES.
	AOS C
	IMULI C,@QSBYTE(A)	;NEXT USE OF FILE WILL GET
	MOVEM C,QRADAD(A)	;WHAT FOLLOWS PAGES MAPPED.
	MOVSI C,%QAACC	;INDICATE ACCESS PTR CHANGED.
	IORM C,QSRAC(A)
;COME HERE TO INSERT PG FROM OTHER USER.
NCORR:	HRRZ E,-3(P)	;TARGET PAGE # C
	HRRZ U,-1(P)	;TARGET JOB TT
	HRRZ TT,(P)	;ACCESS (WRITE BIT IN 2.9)
	PUSHJ P,NCORR1	;ACTUALLY MUNG MAP.
NCORR2:	PUSHJ P,GHUSRA	;TARGET PAGE NUM MUST BE IN E
	POP P,A
	POP P,TT
NCORA1:	POP P,E
	POP P,C
;COME HERE AFTER HANDLING 1 PAGE.
NCORX:	MOVE U,USER
	CLRPGM (U)
	JUMPGE C,NCORX1	;IF LH POS, DON'T REWRITE.
	ADD C,[1,,1]
	ADDI E,1
	UMOVEM C,@SRN3(U)
	SKIPL SRN4(U)	;REWRITE 5TH ARG ONLY IF WAS GIVEN.
	 UMOVEM E,@SRN4(U)
	JUMPGE C,NCORX1
	TLNN A,%CBRED
	 JRST NCORD	;LOOP AROUND FOR DELETE RQ
	JRST NCORL	;FOR INSERT RQ.

NCORX1:	AOS (P)
NCORX0:	PUSHJ P,LSWPOP	;FREE CIRPSW
NCORX2:	CAIN TT,(U)	;IF NOT ACTING ON SELF,
	 POPJ P,
	JRST LSWPOP	;CAN'T FALL THRU SINCE MIGHT BE NULSET.

;THIS IS A LOSSET ROUTINE TO CLEAR THE BSSTP BIT OF THE JOB
;WHOSE INDEX IS IN THE SRN5 OF THE RUNNING JOB.
NCORFS:	MOVE A,SRN5(U)
	MOVSI T,BSSTP
	ANDCAM T,USTP(A)
	POPJ P,
;JSP T,NCORUI   WITH JOB-SPEC IN J, RETURNS USER IDX IN J (OR ,,-1 FOR PDP6)

;JOB SPECS ARE:
;  -1  OR  ,,-1    FOR SELF.
;  <CHNL-NUM>	   (MUST BE USR, STY, JOB OR BOJ DEVICE ELSE OPNL34)
;  400000+<USR NUM>  JOB WITH THAT NUMBER (OPNL35 IF NONE)
;   (  -1,,<USR NUM>  ALSO WORKS)
;IF THIS JOB IS CERTAINLY ALLOWED TO MODIFY SPEC'D JOB, DOESN'T SKIP.
;IF SKIPS ONCE, MUST CHECK FARTHER.  IN EITHER CASE, DIELOK OF JOB HAS BEEN AOS'D
;AND SOSSET'ED, UNLESS ENTRY POINT WAS NCRUI2, OR JOB IS PDP6.
;2 SKIPS => ARG IS RANDOM I-O CHANNEL; CLSTB ENTRY IN H.
;IN THAT CASE, NO SOSSET WAS DONE. RANDOM CHANNELS ALLOWED ONLY IF ENTRY POINT IS NCRUI1.

NCRUI2:	HRLI T,200000	;ENTRY TO SUPPRESS AOS'ING OF DIELOK, AND SOSSET'ING.
	JRST NCRUI3

NCRUI1:	TLOA T,400000	;ENTRY FOR RANDOM CHNLS OK (SKIP TWICE IF SO)
NCORUI:	 TLZ T,400000	;RANDOM DEVS NOT OK
	TLZ T,200000
NCRUI3:	TRZE J,400000
	 HRLI J,-1
	JUMPL J,NCORU1
	CAIL J,NIOCHN	;>0 => CHNL NUM.
	 JRST OPNL14
	ADDI J,IOCHNM(U)
	MOVE H,(J)
	HLRZ J,H
	SKIPGE H,CLSTB(H)
	 JRST NCORU4	;IF INFERIOR, CAN WRITE.
	TLNE H,%CLSBJ	;OR IF BOJ DEVICE
	 JRST [HRRZ J,JBCUI(J) ? JRST NCORU4]
	TLNE H,%CLSST	;STY => USE JOB THAT HAS ASSOCIATED TTY.
	 JRST [	SKIPGE J,TTYSTS(J)
		 JRST OPNL41	;NO JOB HAS THAT TTY.
		ANDI J,-1
		JRST NCORU4]
	TLNE H,%CLSFU	;FOREIGN USR, MUST CHECK.
	 AOJA T,NCORU4
IFN PDP6P,[
	TLNN H,%CLS6
	 JRST NCORU5	;RANDOM DEVICE. (MAYBE DISK)
NCRUI6:	MOVEI J,-1	;PDP6, MUST CHECK.
	JRST 1(T)
];PDP6P
NCORU5:	JUMPL T,2(T)	;RANDOM DEVICE, SKIP TWICE IF THATS OK
	JRST OPNL34

NCORU1:	TRNE J,777400	;CHECK FOR -1 FOR SELF.
	 JRST NCORU2
	ANDI J,377
	CAIN J,377	;CHECK FOR 377 => SUPERIOR.
	 JRST NCORU3
IFN PDP6P,[		;AND FOR 376 => PDP6.
	CAIN J,376
	 JRST NCRUI6
]
	IMULI J,LUBLK	;ELSE WAS USRNUM,
	CAMGE J,USRHI	;CHECK FOR VALID USER
	 SKIPN UNAME(J)
	  JRST OPNL35	;IF NOT, NO SUCH JOB.
	AOJA T,NCORU4

NCORU2:	CAME J,[-1,,377777]
	 JRST OPNL33
	MOVEI J,(U)
NCORU4:	CONO PI,CLKOFF
	MOVE H,APRC(J)	;IS THE JOB WE'RE HACKING DIEING?
	TLNE H,BULGOS
	 JRST OPNL42	;YES, PREVENT TIMING ERRORS.
	TLNE T,200000	;UNLESS ENTRY POINT WAS NCRUI2,
	 JRST NCORU6
	AOS DIELOK(J)	;PREVENT THE JOB FROM DIEING.
	PUSH P,T
	PUSHJ P,SOSSET
	 DIELOK(J)
	POP P,T
NCORU6:	CONO PI,CLKON
	JRST (T)

NCORU3:	SKIPGE J,SUPPRO(U)	;GET SUPERIOR,
	 JRST OPNL35
	MOVEI J,(J)
	AOJA T,NCORU4

;SKIP IF ALLOWED WRITE ACCESS TO PAGES FROM SOURCE IN J
;USE IF NCORUI ETC. SKIPS ONCE.  CALL BY JSP T,.

NCORW1:
IFN PDP6P,[
	CAIN J,-1	;IF IT GETS THIS FAR, USER HAS A PDP6 CHANNEL,
	 JRST 1(T)	; THEREFORE OBVIOUSLY IS ALLOWED TO WRITE PDP6 MEMORY.
];PDP6P
	CAIE J,LUBLK	;CAN GET WRITE ACCESS TO FRESH PAGE,
;SKIP IF ALLOWED TO MODIFY PAGE MAP OF TARGET JOB IN J.
NCORWR:	 CAIN J,(U)	;CAN DO THAT AND STICK PAGE IN SELF
	  JRST 1(T)
	HRRZ H,SUPPRO(J)
	CAIN U,(H)	;AND OUR INFERIORS
	 JRST 1(T)
	SKIPL H,JBI(U)	;AND OUR BOJ DEVICE.
	 CAIE J,JBCUI(H)
	  JRST (T)
	JRST 1(T)

;.CBLK AC,
;(OBSOLESCENT)
	;AC 4.9 MUST BE ZERO
	;4.7 USED INTERNALLY IN CODE (W RQ ON PDP6)
	;4.3-4.1 = 0 GET PAGE FROM SELF
	;	= 1 GET ABSOLUTE PAGE
	;	= 2 GET PAGE FROM USER OPEN ON CH # 3.1-3.8
	;	= 3 GET PAGE FROM USER NUMBER 3.1-3.8
	;	= 4 GET PAGE
	;	= 5 GET PAGE (PUBLIC)
	;	= 6 MAKE PAGE PRIVATE
	;	= 7 MAKE PAGE PUBLIC
	;3.9=1 REQUEST WRITE PERMISSION (IGNORED ON FRESH PAGE, OTHERWISE VALID ONLY FOR
	;		SELF OR DIRECT INFERIOR OPEN ON CH OR PUBLIC PAGE)
	;3.1-3.8  USER NUMBER OR CH # (377 => CREATOR IF JOB DEVICE)
	;2.9=1 INSERT PAGE, 0 DELETE (IGNORES 4.3-4.1 EXCEPT FOR 6 OR 7 WHEN IT IS IGNORED)
	;2.1-2.8 VIRTUAL PAGE TO BE AFFECTED
	;1.1-1.9 BLOCK # IN ABSOLUTE OR OTHER USER (OR SELF IF 4.3-4.1 = 0)

;TO CALL NCBLK, SET UP Q WITH USER INDEX REQUEST IS FOR AND U WITH
;THE USER INDEX MAKING THE REQUEST

;NEW .CBLK CODE, PASSES THE BUCK TO CORBLK.
;SAME AS FAR AS CALLER IS CONCERNED.

ACBLK:	MOVE TT,U	;TARGET USR IDX.
	UMOVE B,(J)
NCBLK0:	MOVEI W,5	;FAKE 5 ARGS TO NCORBL
	LDB C,[111000,,B]	;TARGET PAGNUM.
	LDB E,[1100,,B]	;SOURCE PAGNUM.
	TRNN B,400000
	 JRST NCBLKD	;LIKELY TO BE DELETE RQ.
NCBLK1:	MOVSI A,210000	;NOT DELETE => RQ READ, FAIL IF CAN'T.
	LDB D,[221000,,B]	;SOURCE USR IDX OR CHNL NUM.
	LDB H,[330300,,B]	;REQUEST TYPE-CODE.
	JRST .+1(H)

	JRST NCBLKS	;TYPE 0, SOURCE IS SELF.
	JRST NCBLKA	;TYPE 1, GET ABS PAGE.
	JRST NCBLKC	;2, USE SPEC'D CHNL NUM.
	JRST NCBLKI	;3, USE SPEC'D USR IDX.
	JRST NCBLKF	;4, FRESH PAGE.
	JRST NCBLKP	;5, FRESH PUBLIC PAGE.
	TLOA A,420000	;6, MAKE PRIVATE, SOURCE=TARGET.
	TLO A,440000	;7, MAKE PUBLIC,    "      "
	MOVE E,C	;SOURCE PAGNUM _ TARGET PAGNUM,
NCBLKS:	TROA D,-1	;GET PAGE FROM SELF. (%JSELF=-1)
NCBLKA:	 MOVEI D,%JSABS	;GET ABS PAGE
;IF GET-FROM-CHANNEL, THE CHNL NUM IN D IS DESIRED JOB-SPEC.
NCBLKC:	TLNE B,400	;IF WRITE-RQ BIT ON,
	 TLO A,100000	;INSIST ON WRITE ACCESS.
NCORBX:	CAIE TT,(U)	;IF TARGET .NE. SELF,
	 PUSHJ P,NULSET	 ;FAKE OUT THOSE EXPECTING A LOSSET.
	JRST NCORB9

NCBLKI:	IORI D,%JSNUM	;GET FROM USR IDX, MAKE JOB SPEC.
	JRST NCBLKC

NCBLKP:	TLO A,40000	;GET FRESH PUBLIC PAGE.
NCBLKF:	MOVEI D,%JSNEW	;GET FRESH PAGE
	JRST NCBLKC

NCBLKD:	TLC B,6000	;COME HERE IF BIT 2.9 IS 0
	TLCN B,6000
	 JRST NCBLK1	;(TYPES 6,7 IGNORE THAT BIT)
	SETZB A,B	;OTHERWISE IS DELETE REQUEST.
	JRST NCBLKS

NCBLK:	MOVE B,TT
	MOVE TT,Q
	JRST NCBLK0

;ACTUALLY COPY A PAGE FROM ONE MAP TO ANOTHER
;T PNTR TO MAP COPYING FROM
;TT 400000 BIT 1=> WRITE
;E TARGET PAGE #
;U TARGET USER
;B PNTR TO CIRC LIST

NCORR1:	LDB J,T		;ENTRY FROM NCORR
	TRNN J,600000
	 JRST ACBK3A	;PAGE NON EXISTANT OR SWAPPED OUT
	TRNN TT,400000	;WRITE RQ ?
	 TRZ J,400000	;DOESN'T RQ MORE
	TRNN J,600000
	 TRO J,200000	;IN CASE OF RWF
ACBK3B:	MOVE A,E	;TARGET PAGE #
	PUSHJ P,UPLC
	LDB C,T		;GET PTW ABOUT TO BE CLOBBERED
	TRZ C,PMAGEM	;TURN OFF AGE BITS
	JUMPN C,[JRST 4,.]	;SHOULD HAVE DELETED PAGE BY NOW
	DPB J,T		;SET UP MAP
	TRNN J,600000
	 JRST ACBK3C	;JUMP IF PAGE SWAPPED OUT
	ANDI J,PMRCM
	CAIL J,TSYSM
	 JRST 4,.
IFE SWPWSP,	AOS MMSWP(J)	;AOS NUMBER OF USERS POINTING TO PAGE
IFN SWPWSP,[
	HRRZ TT,MMSWP(J)
	AOS MMSWP(J)	;AOS NUMBER OF USERS POINTING TO PAGE
	MOVSI C,1	;ADJUST WORKING SET OF TARGET JOB
	IDIV C,TT	;1,,0 IF DIVISION BY ZERO
	ADDM C,UWRKST(U)
	JUMPE TT,ACBK3D	;JUMP IF NO SHARERS
	IMULI TT,1(TT)	;COMPUTE ADJUSTMENT TO ALL WORKING SETS
	MOVSI C,-1	;DUE TO INCREASE IN SHARING
	IDIV C,TT
	MOVE D,C
	PUSH P,U
	PUSH P,I
	PUSHJ P,UCPRL7	;CLOBBERS C,H,I,U
	    400000,,SWOP6B
	POP P,I
	POP P,U
];SWPWSP
ACBK3D:	LDB J,B		;POINTER TO PREVIOUS IN CHAIN
	DPB J,Q		;PATCH
	MOVE C,U
	IDIVI C,LUBLK
	DPB C,[101000,,A]
	DPB A,B		;PATCH
	AOS NMPGS(U)
	AOS SNMPGS	;SYSTEM HAS 1 MORE PAGE
	POPJ P,

ACBK3A:	TRNN TT,400000
	 TRZ J,2
	TRO J,1		;IN CASE OF R/W/F
	JRST ACBK3B

ACBK3C:	AOS NSWPGS(U)
	AOS SNSWPG
	JRST ACBK3D
ACRF1:	MOVE TT,B
	MOVE W,Q	;INDEX OF USER THAT REQUEST IS FOR
	IDIVI W,LUBLK	;CLOBBERS H
	HRL TT,W
	TLNE TT,600000
	 JRST 4,.
	JRST ACRFL

NACRFL:	PUSHJ P,LSWPOP	;UNLOCK CASW OR CIRPSW
ACRFL:	PCLT
	SKIPL CORRQ(U)	;CURRENT USER IN U COR RQ FOR USER IN Q
	 PUSHJ P,UFLS	;WAIT FOR MY CORE RQ TO CORE JOB TO CLEAR
	MOVSI J,BUSRCR
	MOVE T,J
	TDNE T,APRC(Q)
	 PUSHJ P,UFLS	;SOMEBODY ELSE HAS RQ IN ON THIS JOB WAIT TO CLEAR
	PUSHJ P,SWTL
	    CASW	;GET CORE ASSIGN SW
	TDNE J,APRC(Q)
	 JRST NACRFL	;CHECK FOR TIMING ERROR
	TLNN TT,200000
	 JRST ACRF6	;OLD TYPE
	MOVNI J,1	;ADDING ONE BLOCK
	MOVEI B,105	;FAKE OUT CORE TO ZERO CHECK
	JRST ACRF8

ACRF6:	MOVE J,HUSRAD(Q)
	LSH J,-10.
	CAMN J,B
	 JRST LSWPJ1	;SAME AMOUNT AS NOW
	MOVE T,APRC(Q)
	TLNE T,BULGOS
	 JUMPN B,LSWPOP	;TRYING TO CORE NON-ZERO A JOB THAT IS DYING?
	SUB J,B		;GET AMT OF DECREASE (- => INCREASE)
	CAMGE J,[-20.]
	 JRST ACRF6A	;GET 20 AT A WHACK MAX
ACRF8:	MOVN I,J	;I GETS POSITIVE # OF PAGES ADDED
	ADD J,MEMFR
	SUB J,NCBCOM	;J GETS AMT THAT WILL BE LEFT
	CAIGE J,5
	 JUMPG I,ACRF7	;NOT ENUF CORE
	MOVEI J,0	;INDICATE RQ WILL BE COMPLETELY SATISFIED
	CAIL I,20.
	 MOVNI J,1	;MAKE SURE RQ IS REALLY FILLED
ACRF5:	JUMPL I,ACRF2	;JUMP IF DECREASING CORE
	JUMPE Q,ACRF3	;SYSTEM JOB DOESN'T USE MMP
	MOVN T,I
	ADDB T,MMPFR	;COMMIT SUFFICIENT NUMBER OF MMP ENTRIES
	JUMPGE T,ACRF3	;JUMP IF THAT MANY ARE AVAILABLE
	ADDM I,MMPFR	;MMP FULL, DECOMMIT THE MMP ENTRIES
	JRST LSWPOP	;AND TAKE ERROR RETURN

ACRF2:	AOSA NCRQL	;COUNT # REQUESTS FOR LESS
ACRF3:	 ADDM I,NCBCOM	;IF EXPANDING, COMMIT SUFFICIENT AMOUNT OF PHYSICAL CORE
	MOVSI T,BUSRCR
	IORM T,APRC(Q)	;CORING USER
	MOVEM TT,CORRQ(U)
	AOS NCORRQ
	PUSHJ P,LSWPOP	;UNLOCK
IFN SCHBLN,[
	CONO PI,CLKOFF	;GET CORE JOB TO RUN RIGHT AWAY
	MOVE I,USER	;THEN COME RIGHT BACK TO US (WHAT A CROCK THIS ALL IS)
	PUSHJ P,SCHSB
	MOVEI I,LUBLK
	PUSHJ P,SCHSB
	CONO PI,CLKON
];SCHBLN
	PCLT
	SKIPL CORRQ(U)	;WILL NOT SKIP AT FIRST
	 PUSHJ P,UFLS
	JUMPN J,ACRF1	;REALLY NEED TO TAKE ANOTHER WACK AT THIS
	JRST POPJ1

ACRF7:	PUSHJ P,LSWPOP
	PCLT
	MOVE T,I
	PUSHJ P,CFHPO3
	 PUSHJ P,UFLS
	TLNE TT,200000
	 JRST ACRFL
	JRST ACRF1

ACRF6A:	ADDI J,20.
	ADD TT,J	;GET REDUCED RQ
	MOVNI J,20.
	JRST ACRF8

SUBTTL CORE ALLOCATOR - CORE JOB ROUTINES

CORJI:	MOVE P,USRPDL+L	;SET UP CORE JOB PDL
	JRST CORJOB

CORJ2:	AOSN UTBFLF
	 JRST UTBFF	;FLUSH UTAPE
	AOSN UFDFLF
	 JRST UFDFF	;FLUSH 2314 UFDS
	SKIPE MMPFS2
	 JRST RETMM2	;FLUSH PARTIALLY-RETURNED MMP ENTRIES
	SKIPE QFBTS
	 JRST [	PUSHJ P,QDLFBT	;RETURN DISK BLOCKS TO FREE
		SOS NCORRQ
		JRST CORJOB ]
	SKIPE NCRQL
	 JRST CORJOB	;RQ'S FOR LESS HAVE COME IN. BETTER EXECUTE THEM OR MAY NOT HAVE ENUF CORE
	SKIPL CORUPU
	 JRST CORUP	;FOUND USER IN SEARCH WHO WANTS MORE GIVE IT TO HIM
	SKIPL CORSRV
	 JRST CORJOB
	MOVE A,LMEMFR
	CAMGE A,MINCOR
	 PUSHJ P,CFLM1	;FREE SOME LOW MEMORY BY SHUFFLING
	SKIPLE NCORRQ
	 SOS NCORRQ	;CAN'T FIND ANYTHING TO DO SO DECREMENT COUNT
		;THIS CAN HAPPEN AS A RESULT OF EXCESS ATTEMPTED UTAPE FLUSHAGE
		;OR DUE TO CALLING CFLM1
CORJOB:	PUSHJ P,ACMTC	;XFER ANY "SPECIAL FREE" MEM BLOCKS TO FREE
	SKIPN NCORRQ	;ANYONE WANT CORE?
	 PUSHJ P,[	;IF NOT, WAIT UNTIL SOMEONE DOES, BUT FIRST
		MOVE TT,QMDRO	;SEE IF MFD AND TUTS NEED TO BE READ IN
		AOJE TT,IDSK
		JRST UFLS ]	;WAIT
	SETOM CORSRV	;INITIALIZE NO RQS SERVED THIS PASS
	SETOM CORUPU
	MOVNI U,LUBLK	;SCAN FOR USER WITH HIGHEST PRIORITY
CORLUP:	ADDI U,LUBLK
	CAML U,USRHI
	 JRST CORJ2	;THRU EXAMINE RESULTS OF SEARCH
	SKIPGE B,CORRQ(U)
	 JRST CORLUP
	TLNE B,200000
	 JRST CORNEW
	LDB Q,[221000,,B]
	IMULI Q,LUBLK
	MOVE A,HUSRAD(Q)
	LSH A,-10.	;COMPUTE # BLKS JOB HAS NOW
	CAIN A,(B)
	 JRST 4,CORL1	;SAME AS NOW, CHECKED FOR AT ACORE
	CAIG A,(B)
	 JRST CORLUG	;INCREASE
	MOVEM U,CORUPU	;DECREASE HAS PRIORITY
	HRRZS B
	SUB B,A
	MOVEM A,CORUPS
	MOVEM B,CORUPA	;DIFFERENCE
	MOVEM Q,CORUUC
	JRST CORUP

CUSTOP:	PUSHJ P,RPCLSR	;STOP USER WHO IS BEING CORED
	MOVSI T,BUCSTP	;(THE BUCK STOPS HERE)
	IORM T,USTP(A)
	PUSHJ P,UPCLSR
	MOVEI T,-1	;GET MASK FOR RH
	TDNE T,USTP(A)	;WAIT FOR RANDOM STOPS TO CLEAR
	 PUSHJ P,UFLS
	POPJ P,

;Core job initializes disks while system job stands around and supervises
;This makes it possible for system job to print any resulting error messages
;Provided no one hits ^Z too soon
IDSK:	MOVE I,MDSK
	MOVE U,USER
	PUSHJ P,QMCH1
	MOVSI I,-NQS
	SKIPL QACT(I)
	 PUSHJ P,QTCH1
	AOBJN I,.-2
	MOVSI TT,SCLIDK		;System is up now
	IORM TT,SUPCOR
	JRST CORJI

EBLK

CORUPU:	-1	;BEST USER SO FAR TO CHANGE CORE
		;IF SETOMED AT CORUPR, REQUEST NOT COMPLETELY FILLED
CORUPA:	0	;INCREASE AMOUNT(1 FOR .CBLK)
CORUPS:	0	;CURRENT SIZE
CORUUC:	0	;USER CORE REQ ACTUALLY FOR
CORSRV:	-1	;0 => RQ SRVED THIS TIME THRU USER VARS
NCRQL:	0	;# RQS FOR LESS

BBLK

CORLUG:	HRRZS B	;GUY WANTS MORE GIVE GUY WHO WANTS LEAST PRIORITY
	SUB B,A
CORLUH:	MOVE A,NMPGS(Q)
	SKIPGE CORUPU
	JRST CORLG1	;FIRST
	CAMGE B,CORUPA	;IS RQ SMALLER?
	JRST CORLG1
CORLG2:	CAME B,CORUPA	;OR IF TIE GIVE IT TO GUY WHO IS SMALLER NOW
	JRST CORG1A
	CAML A,CORUPS	;IS RQ= & SIZE SMALLER?
	JRST CORG1A
CORLG1:	MOVEM U,CORUPU	;HIGHEST PRIORITY SO FAR
	MOVEM B,CORUPA
	MOVEM A,CORUPS
	MOVEM Q,CORUUC
CORG1A:	JRST CORLUP

CORNEW:	LDB Q,[1100,,B]		;.CBLK TYPE RQ
	IMULI Q,LUBLK
	MOVEI B,1
	JRST CORLUH

CORUP:		;EXECUTE REQUEST
	MOVE U,CORUUC
	MOVEM U,CUSER
	SKIPL D,CORUPU
	 SKIPN UNAME(U)
	  JRST 4,.
	MOVE A,CORUUC
	JUMPE A,CORUP8	;DONT USTOP SYS JOB
	PUSHJ P,CUSTOP	;STOP GUY
CORUP8:	PUSHJ P,SWTL
	    CIRPSW
	MOVE TT,CORRQ(D)
	TLNE TT,200000
	 JRST CORUPN	;.CBLK TYPE
	MOVE B,CORUPS
	MOVE A,B	;A HAS CURRENT SIZE
	ADD B,CORUPA	;B HAS NEW SIZE
	PUSHJ P,SWTL
	    MEMFRZ
	SKIPL J,CORUPA
	 JRST CORM1C	;WANTS MORE THAN NOW
CORL2:	LDB A,[121100,,HUSRAD(U)]
	CAMG A,B
	 JRST CORUPR
	SOS A
	PUSH P,B
	PUSHJ P,UPGRTN	;RETURN USER PG
	POP P,B
	JRST CORL2

CORUPR:	MOVE U,CUSER	;FINISHED FOR NOW ANYWAY REVIVE USER
	SKIPN UNAME(U)
	 JRST 4,.
IFN E.SP,[
	CAMN U,DISUSR
	 PUSHJ P,E.SLPM	;LOAD PAGE MAP
]
IFN 340P,[
	CAMN U,DISUSR
	 PUSHJ P,DCRRST	;DIS IS RUNNING BUT UPDATE UPR ETC
]
	MOVSI A,BUCSTP
	ANDCAM A,USTP(U)	;RESTART USER
	PUSHJ P,LSWPOP	;UNLOCK MEMORY
	PUSHJ P,LSWPOP
	PUSHJ P,ACMTC	;XFER IN PROCESS BLOCKS TO FREE
	SKIPGE U,CORUPU
	 JRST CORJOB	;NOT THRU WITH THIS RQ
	MOVE A,CORUUC	;THRU WITH RQ
	SETOM CORUPU
	SKIPGE CORUPA
	 SOS NCRQL	;FINISHED A REQUEST FOR LESS, DECREMENT COUNT OF THEM
	MOVSI TT,BUSRCR
	ANDCAM TT,APRC(A)	;CLEAR RQ PENDING THIS USER FLAG
CORL1:	SETOM CORRQ(U)
	CLEARM CORSRV
	SOSE NCORRQ
	 JRST CORLUP
	JRST CORJOB

CORUPN:	LDB A,[111000,,TT]
	PUSHJ P,SWTL
	    MEMFRZ
	PUSH P,A
	PUSHJ P,UPGRTN
	POP P,E
	TLNE TT,4000
	 TRNN TT,400000
	  JRST 4,.
	TLO E,600000+PMCSHM	;ADD FRESH PAGE
	PUSH P,TT
	PUSHJ P,CORGP
	POP P,TT
	LDB A,[111000,,TT]
	PUSHJ P,UPLC
	LDB B,T
	TRNN B,400000
	 JRST 4,.	;LOSEY
	MOVE C,Q
	PUSHJ P,UCPRL
	    200000,,[	LDB B,[330100,,TT]
			DPB B,[430100,,(C)]
			POPJ P, ]	;SET TO DESIRED PUBLICNESS
	SOS NCBCOM
	JRST CORUPR

CORM1C:	MOVEM J,CORCNT
CORM1A:	JUMPE U,CORS2	;SNIFFLE
CORM1B:	MOVE U,CORUUC
	LDB E,[121100,,HUSRAD(U)]
	TLO E,600000+PMCSHM
	PUSHJ P,CORGP
	SOS NCBCOM
	SOSLE CORCNT
	 JRST CORM1A
	JRST CORUPR

;INSERT FRESH PAGE INTO USR MEM IN PLACE SPECIFIED BY E PROT BITS IN LH
;MMPFR SHOULD HAVE BEEN SOS'ED ALREADY

CORGP:	JUMPN U,CORGP0	;JUMP UNLESS GIVING PAGE TO SYS JOB
	MOVE A,SJSPG	;GOBBLE PAGE RESERVED
	SETZM MEMBLT(A)
	CAIL A,SYSB
	 JRST CORGP1	;USER VARIABLES, CLEAR IT OUT
	JRST CORGP2	;INITIAL GET OF SYSTEM, DON'T ZERO IT

CORGP0:	PUSHJ P,GMMPP	;RETN MMP PNTR IN R
	 JRST CORGPZ
	PUSHJ P,TCALL
	  JRST HMEMRQ	;GET MEM, HIGH IF POSSIBLE
	 JRST 4,.
CORGP1:	PUSHJ P,CZRR
CORGP2:	AOS NMPGS(U)
	AOS SNMPGS	;INCR SYS PAGE COUNT (VIRT)
	PUSH P,A	;REAL CORE BLOCK #
	HRRZ A,E	;ADDR IN USERS MAP
	PUSHJ P,UPLC
	POP P,A
	LDB B,Q
	SETZM MMSWP(A)
	JUMPE U,CORGP3	;IF SYS JOB, DON'T TRY TO SET UP MAP
	JUMPN B,[JRST 4,.]	;ALREADY HAS PAGE
	AOS MMSWP(A)	;INDICATE THAT ONE USER MAP POINTS AT THIS PAGE
	TSO A,E		;SET PROTECTION BITS
	DPB A,T		;STORE IN USER'S MAP
	MOVE C,R	;MMP IDX
	TRO R,400000	;MAKE USERS CP POINT AT MMP
	DPB R,Q
IFN SWPWSP,[
	MOVSI TT,1	;INCREASE WORKING SET
	ADDM TT,UWRKST(U)
];SWPWSP
	ANDI A,PMRCM	;TURN ACCESS BITS BACK OFF
CORGP3:	CAIL A,TSYSM
	 JRST 4,.
	MOVEI TT,MURUSR
	DPB TT,[MUR,,MEMBLT(A)]	;SET USER FIELD IN MEMBLT
	MOVE TT,U
	IDIVI TT,LUBLK
	LSH TT,8
	IOR TT,E	;PG # IN USER'S MAP
	SKIPN U
	 MOVEI TT,600000(A)	;IF SYS JOB, MEM BLOCK POINTS AT SELF
	HRRZM TT,MEMPNT(A)	;ELSE MAKE MEM BLOCK POINT AT USERS MAP
	JUMPE U,GHUSRA	;IF SYS JOB, NO MMP ENTRY
	DPB C,[MMMPX,,MEMBLT(A)];STORE INDEX OF MMP ENTRY IN MEMBLT
	TRO A,600000
	HRRM A,MMP(C)	;MAKE MMP POINT AT MEM BLOCK
	PUSHJ P,CHACK	;FOR CHECKING ONLY
	CAME C,[SETZ 3]	;REAL MEM, 3 ENTRIES (MMP, MEMPNT, USER)
	 JRST 4,.
GHUSRA:	AOS E
	LSH E,10.	;COMP NEW HUSRAD AFTER GETTING PAGE
	TLZ E,-2	;FLUSH PROTECT BITS (LEAVE 3.1)
	CAMLE E,HUSRAD(U)
	 MOVEM E,HUSRAD(U)
	POPJ P,

CORGPZ:	PUSH P,E	;SAVE REGISTERS
	PUSH P,U
	PUSHJ P,CFLM2	;TRY TO FREE UP SOME LOW MEMORY
	POP P,U
	POP P,E
	SKIPE LMEMFR
	 JRST CORGP	;SHOULD WORK NOW
	PUSHJ P,LSWPOP	;MEMFRZ
	PUSHJ P,LSWPOP	;CIRPSW
	BUG INFO,[NO CORE AVAIL FOR MMP PAGE]
	PUSHJ P,UDELAY	;Break possible infinite loop if no user pgs in low mem
	SKIPG MEMFR	;WAIT FOR SWAPPER TO MAKE ROOM (PANIC!)
	 PUSHJ P,UFLS
	PUSHJ P,SWTL
	  CIRPSW
	PUSHJ P,SWTL
	  MEMFRZ
	JRST CORGP

PAGERT:	PUSHJ P,SWTL
	    MEMFRZ
	PUSHJ P,UPGRTN
	JRST LSWPOP

UPGRTN:	PUSH P,R	;RETURN VIRT PG # IN A USER IN U
	PUSH P,I
	PUSH P,TT
	PUSH P,E
IFN XGP,[
	PUSHJ P,UPLC	;SEE IF PAGE XGP LOCKED
	LDB E,T
	TRNN E,600000
	 JRST UPGRT7	;SWAPPED OUT, OBVIOUSLY NOT XGP
	ANDI E,PMRCM	;E := PHYS PAGE NO
	CAIL E,TSYSM
	 JRST UPGRT7
	IDIVI E,36.
	MOVNS TT
	PUSH P,T
	MOVSI T,400000
	LSH T,(TT)
	TDNE T,XGPMTB(E)
	PUSHJ P,UFLS	;WAIT FOR XGP TO CLEAR
	POP P,T
UPGRT7:	]
.ELSE	PUSHJ P,UPLC	;FIND PAGE IF DIDN'T ALREADY
	JUMPE U,UPGRT8	;SYS JOB, NO SWAPPING NOR MMP ENTRY
	LDB B,Q
	CAIN B,-1
	 JRST UPRABS	;ABSOLUTE PAGE
	JUMPE B,RHUSRA	;DOESNT REALLY HAVE PG
	PUSH P,T
	PUSHJ P,CHACK	
	ADD D,MMPEAD	;D HAS MMP ADDRESS
UPGRTA:	MOVSI T,MMPTMP
	TDNE T,(D)
	 JRST UPGRTW	;WAIT FOR PAGE TO TRANSIT BUT UNLOCK SWITCHES
	MOVNI I,1	;ASSUME NO DISK SPACE
	HLRZ A,1(D)	;SEE IF DISK SPACE ASSIGNED
	JUMPE A,UPGRT5
	LDB I,[$MMPUN,,(D)]
	PUSHJ P,QTLOCK	;LOCK APPRO TUT
UPGRT5:	POP P,T		;POINTER TO ORIG MAP ENTRY OF USER
	MOVE H,(T)	;SAVE MAP WORD FOR DEBUGGING
	LDB TT,T	;IF PROT BITS=0 PAGE IS SWAPPED OUT FOR PURPOSES
	MOVEI E,0	;OF USER'S SWAP OUT COUNT, EVEN IF IN CORE
	DPB E,T		;CLEAR USER MAP ENTRY
	TRCN TT,600000	;IS USER MAPPED TO PAGE?
	 JRST UPGRT9
	MOVSI E,MMPWRT	;YES, CHECK IF ACCESS BITS = RW
	TRNN TT,600000
	 IORM E,(D)	;PAGE WRITTEN BY USER WHO HAS DETACHED IT
	ANDI TT,PMRCM	;MASK TO MEM PAGE #
	CAIE TT,(J)
	 JRST 4,.	;PTW POINTED TO WRONG PAGE
	MOVSI E,MMPOUT+MMPTMP
	TDNE E,(D)
	 JRST 4,.	;PAGE NOT IN, IN MMP
IFE SWPWSP,	SOS MMSWP(J)	;ONE LESS USER POINTING AT PAGE
IFN SWPWSP,[
	HRRZ E,MMSWP(TT)	;DECREASE THIS USER'S WORKING SET
	MOVSI T,-1
	IDIVM T,E
	ADDM E,UWRKST(U)
	SOS MMSWP(TT)
	HRRZ E,MMSWP(TT)
	JUMPE E,UPGRTB	;JUMP IF NO OTHER SHARERS, FOR SPEED AND NO ZERODIVIDE
	PUSH P,C	;ADJUST OTHER SHARER'S WORKING SETS
	PUSH P,D
	PUSH P,I
	PUSH P,U
	IMULI E,1(E)
	MOVSI D,1
	IDIV D,E
	PUSHJ P,UCPRL7	;CLOBBERS H ALSO C,T,U,I
	    400000,,SWOP6F
	POP P,U
	POP P,I
	POP P,D
	POP P,C
];SWPWSP
	JRST UPGRTB

;RETURNING A PAGE TO WHICH USER IS NOT CURRENTLY MAPPED (MAY BE IN OR OUT)
UPGRT9:	SOS NSWPGS(U)
	SOS SNSWPG	;DECR CNT OF SWAPPED OUT FOR SYS
	JUMPGE C,UPGRT4	;NO MEM IN CP S, PAGE REALLY SWAPPED OUT
;RETURNING A PAGE WHICH IS SWAPPED IN
UPGRTB:	HLRE E,MMSWP(J)	;GET # EXEC PGS POINTING TO THIS
	JUMPL E,[JRST 4,.]	;<0 EXEC PAGES
	JUMPE E,UPGRT4	;NO EXEC PGS POINTING TO THIS
	PUSH P,J
	MOVE TT,J
	MOVSI T,-NEXPGS	;LOOK FOR EXEC PGS SET UP TO PNT
	MOVE E,[442200,,EXEUMP]	;TO USER PAGE FLUSHED
UPGRT3:	ILDB J,E
	TRZN J,600000
	 JRST UPGRT2
	ANDI J,PMRCM
	CAMN TT,J
	 JRST UPGRT1
UPGRT2:	AOBJN T,UPGRT3
IFN E.SP,[
	MOVSI T,-1
	TDNE T,MMSWP(TT)
	 PUSHJ P,E.SPRT		;SEE IF E&S HAS IT
]
IFN XGP,[
	MOVSI T,-1
	TDNE T,MMSWP(TT)	;FLUSH XGP TIE DOWNS AND RETURN
	 PUSHJ P,XGPCFL
]
	POP P,J
UPGRT4:	LDB T,Q	;DELINK CIRC PNTR
	DPB T,B
	MOVEI T,0
	DPB T,Q		;CLOBBER CIRC P
	SOS NMPGS(U)
	SOS SNMPGS	;SYSTEM HAS 1 LESS PAGE
	CAME C,[SETZ 3]
	CAIN C,2
	 JRST MMPRTN	;RETURN MMP ENTRY SINCE PAGE NO LONGER IN USE
MMPRT4:	MOVE A,J
	CAMN C,[SETZ 3]
	 JRST MMPRT5	;FLUSH REAL MEM
MMPRT6:	SKIPL I
	 PUSHJ P,QTULK
RHUSRA:	POP P,E
	POP P,TT
	POP P,I
	POP P,R
RHUSR1:	LDB A,[121100,,HUSRAD(U)]	;COMP HUSRAD AFTER RETURNING PAGE
	JUMPE A,CPOPJ
	SOS A
	PUSHJ P,UPLC
	LDB B,Q
	JUMPN B,CPOPJ	;FOUND ACTIVE PAGE
	MOVNI C,2000	;KEEP LOOKING
	ADDM C,HUSRAD(U)
	JRST RHUSR1

UPGRT8:	SOS NMPGS	;RETURNING PAGE FROM SYS JOB
	SOS SNMPGS
	DPB A,[121100,,HUSRAD(U)] ;NORMAL METHOD OF COMPUTING HUSRAD WON'T WORK
	MOVNI I,1	;NO DISK SPACE
MMPRT5:	SKIPE MMSWP(A)	;MAKE SURE NO ONE (EXEC OR USER) IS POINTING AT PAGE
	 JRST 4,.
	PUSHJ P,CMEMR	;HAS REAL MEM, CIRC LENGTH =3 SO FLUSH MEM
	JRST MMPRT6

UPRABS:
IFN TEN11P,[
	LDB B,T
	LDB E,[.BP <PMRCM-377> B]	;GET MOBY #
	CAIE E,T11CPA_-18.
	JRST UPRAB1
	ANDI B,377
	PUSHJ P,T11DL	;DELETE PAGE REF TO TEN11 MAP
UPRAB1:]
	MOVEI B,0
	DPB B,Q
	DPB B,T
	JRST RHUSRA

IFN E.SP,[
;TT/MMSWP INDEX
E.SPRT:	CAME U,DISUSR	;IS HE USING THE DISPLAY?
	 POPJ P,	;NO, DON'T UNTIE ANYTHING
	PUSH P,H
	MOVE T,TT	;FOR E.SPCH
	PUSHJ P,E.SPCH	;LOOK IN E&S TABLES
	 SKIPA		;FOUND, INDEX IN H
	  JRST E.SPR2	;NOT FOUND, DO NOTHING
	MOVSI T,-1
	ADDM T,MMSWP(TT) ;SOS COUNT
	SETZM DISSWP(H)	;CLEAR DISPLAY MMSWP TABLE
	AOS E.SNUT	;COUNT FOR UNTIES
E.SPR2:	POP P,H
	POPJ P,
]
UPGRT1:	MOVSI J,-1
	XCT EXPFT(T)	;MAYBE XFERR TO ROUTINE TO DO SOMETHING ABOUT THIS
	 JRST UPGRT6	;NOT USER CONCERNED ABOUT (THERE HAD BETTER BE ANOTHER)
	MOVEI J,0
	DPB J,E	;CLEAR OUT EXEC PAGE ENTRY
	MOVE J,USER
	CLRPGM (J)
UPGRT6:	CONO PI,UTCON
	JRST UPGRT2

;WAIT FOR PAGE TO TRANSIT, WITH CIRPSW FREE (IN CASE SWAP READ ERROR!)
;COME HERE WITH T/MMPTMP,, D/MMP.ENTRY.ADDR
UPGRTW:	MOVE B,D
NCRMMW:	MOVE U,USER
	PUSHJ P,LSWCLR
	PCLT
	TDNE T,(B)
	 PUSHJ P,UFLS	;WAIT FOR ACTIVE PAGE TO SETTLE DOWN
	CAIE U,LUBLK	;SKIP IF CORE JOB
	 JRST UUOTROLL	;AS IF PCLSR'ED OUT OF WAIT FOR PAGE & CAME BACK
	SETOM CORUPU	;REQUEST FOR THIS USER NOT SATISFIED
	MOVE P,USRPDL+LUBLK	;CLEAN UP AND RE INIT CORE JOB
	PUSHJ P,NULSET
	PUSHJ P,NULSET
	JRST CORUPR

EXPFT:
IFN 340P,	REPEAT 2+N340PB,	PUSHJ P,DISACR
	REPEAT 2,JFCL		;CORJF, CORJT
IFN VIDP,	REPEAT 2,PUSHJ P,SCNACR
IFN TEN11P,	JRST 4,.	;TEN-11 CONTROL PAGE
	JRST 4,.		;PAREP
IFN ECCMEM,	JRST 4,.	;ECCPG
IFN XGP,	REPEAT 3,JRST 4,.
IFN N11TYS,	REPEAT NTTPG+NTVBP,JRST 4,.
IFN CHAOSP, IFN T11CHP, JRST 4,.
	REPEAT NMMP,JRST 4,.	;MMP
IFN .-EXPFT-NEXPGS, .ERR LOSE AT EXPFT
;CIRCULAR MEM LIST HACKER
;CALL WITH Q CONTAINING BYTE POINTER TO CIRC PNTR IN LIST TO BE HACKED
;THE BYTE POINTER MUST POINT AT A UPGCP ENTRY (RATHER THAN MEMPNT OR MMP)
;OR THIS CODE WILL LOOP FOREVER.
;RETN BYTE PNTR IN B TO GUY WHO PNTS TO THAT PNTR
;COUNT FOR ENTRIES IN C (RH)
; 4.9 C SAYS ACTUAL MEM IN LOOP
;RETN IN D MMP INDEX
;RETURN MEM PAGE IF ANY IN J
;CLOBBERS H,I,W

CHACK:	PUSH P,A
	LDB J,Q	;PICK UP STARTING C. P.
	SETZM C
	MOVNI D,1
	MOVE B,Q
CHACK1:	JUMPE B,[JRST 4,.]
	AOS C
	CAIE J,-1	;SKIP ON ABS PAGE
	 TRNE C,776000
	  JRST 4,.	;CIRC CHAIN TOO LONG?
	TRZE J,400000
	 JRST CHACK3	;MEMPNT OR MMP PNTR
	LDB I,[1000,,J]	;PG #
	LDB H,[101100,,J]	;USER #
	IMULI H,LUBLK
	SKIPE UNAME(H)
	 CAML H,USRHI
	  JRST 4,.	;POINTER TO NON-EXISTENT USER
	MOVEI W,UPGCP(H)
	ROT I,-1
	ADDI W,(I)
	HRLI W,222200
	SKIPGE I
	 HRLI W,2200
	CAMN W,Q
	 JRST CHACK2	;FOUND ENTRY WHICH PNTS AT ORIGINAL ENTRY
	LDB J,W
	MOVE B,W
	JRST CHACK1	;KEEP LOOKING

CHACK2:	MOVE J,A
	JUMPL D,[JRST 4,.]	;NO MMP ENTRY ?
	JRST POPAJ

CHACK3:	TRZE J,200000
	 JRST CHACK4	;ACTUAL CORE
	CAML J,MMPMX
	 JRST 4,.	;GARBAGE POINTER
	MOVSI B,2200	;MMP ENTRY
	HRR B,MMPEAD
	ADDI B,(J)
	JUMPGE D,[JRST 4,.]	;MORE THAN 1 MMP ENTRY
	MOVE D,J
	LDB J,B
	JRST CHACK1

CHACK4:	TLOE C,400000
	 JRST 4,.	;PAGES IS IN TWO PLACES IN CORE
	CAIL J,TSYSM
	 JRST 4,.	;GARBAGE POINTER
	MOVE A,J	;SAVE MEMBLT INDEX
	MOVSI B,2200
	HRRI B,MEMPNT
	ADDI B,(J)
	LDB J,B
	JRST CHACK1

;LOOK UP PAGE IN USER MAP
;USER IN U, VIR PG # IN A
;GET PNTR TO MAP HW IN T, TO CIRC IN Q

UPLC:	SKIPL A
	CAIL A,400
	 JRST 4,.		;BAD VIRTUAL PAGE NUMBER
	PUSH P,A
	MOVEI Q,UPGCP(U)
	MOVEI T,UPGMP(U)
	ROT A,-1
	ADDI T,(A)
	HRLI T,222200
	SKIPGE A
	 HRLI T,2200
	ADDI Q,(A)
	HLL Q,T
	JRST POPAJ

;FREE THE MMP ENTRY D POINTS AT, SOSING TUT IF DISK SPACE ASSIGNED.
;I HAS DSK #, C HAS WHAT CHACK RETURNED IN C, A HAS TRACK #.
;TUT MUST BE LOCKED ALREADY. CIRPSW AND MEMFRZ SHOULD BE LOCKED.
;EXIT TO MMPRT4 OR RHUSRA

MMPRTN:	MOVEM C,MMPRTC	;SAVE IN CASE OF BUG HALT LATER
	JUMPL I,MMPRT3	;NO DISK SPACE ASSIGNED
	PUSH P,B
	LDB B,[$MMPUN,,(D)]
	CAME B,I
	 JRST 4,.	;WRITING WRONG DISK
	MOVE H,D	;H SAVES POINTER TO MMP ENTRY
	MOVE D,A	;D GETS DISK TRACK NUMBER
	PUSHJ P,TUTPNT
	CAIGE B,TUTMNY
	 SOJL B,[JRST 4,.]	;DETECT OVER-SOS
	DPB B,D
	EXCH D,H	;D GETS MMP PNTR, H GETS TUT BYTE PNTR
	JUMPN B,MMPRT2
	MOVE T,QTUTO(I)
	CAML A,QSWAPA(T)
	 AOS QSFT(I)
	CAMGE A,QSWAPA(T)
	 AOS QSFTS(I)
MMPRT2:	MOVE T,DCHBT(I)
	IORM T,QTUTO(I)
	MOVE A,(D)	;ELSE DELETE MMP ENTRY NOW
	SKIPGE C
	 JUMPN B,MMPRT0	;IF PG IS IN FILE, AND SWAPPED IN, MAYBE WRITE OUT.
	TLNN A,MMPSHR
	 JRST MMPRT8
	HLRZ A,1(D)	;ALSO REMOVE FROM SHAREABLE PAGE TABLE
	HRL A,I
	IDIVI A,SHRHSL
	ADDI B,SHRHSH-1
MMPRT7:	MOVE A,B
	HRRZ B,1(B)
	JUMPE B,[JRST 4,.]
	CAME B,D
	 JRST MMPRT7
	HRRZ B,1(B)
	HRRM B,1(A)
MMPRT8:	POP P,B
	JUMPL C,MMPRT3	;WAS MEM IN LOOP SO NOT SWAPPED OUT FOR SYSTEM'S COUNT
	SOS NPGSWO	;IT WAS SWAPPED OUT
MMPRT3:	PUSHJ P,MMPRT1
	SOS MMPCNT	;1 LESS IN USE
	AOS MMPFR	;1 MORE FREE
	JRST MMPRT4

;FLUSHING AN MMP ENTRY FOR A PAGE SHARED WITH A FILE WHICH IS CURRENTLY IN CORE.
;WE MAY WANT THIS PAGE AGAIN, SO TRY TO KEEP IT AROUND FOR A WHILE.
;BUT IF PAGE HAS BEEN MODIFIED, IMMEDIATELY SWAP IT OUT SO FILE GETS UPDATED.

MMPRT0:	POP P,B
	LDB C,H		;UN-SOS THE TUT
	CAIGE C,TUTMNY	;DON'T OVER-AOS
	 AOS C
	DPB C,H
	PUSHJ P,QTULK
	MOVEI C,.BM MLO
	ANDCAM C,MEMBLT(J)
	SKIPE C,LLOOSP		;ADD TO TAIL OF LOOSE PAGE LIST
	 DPB J,[MLO,,MEMBLT(C)]
	MOVEM J,LLOOSP
	SKIPN C
	 MOVEM J,FLOOSP
	AOS NLOOSP
	TLNN A,MMPWRT
	 JRST RHUSRA
	PUSH P,U	;PAGE WAS MODIFIED, SWAP IT OUT RIGHT AWAY
	CONO PI,CLKOFF	;CALL SWAPPER AT IMITATION CLOCK LEVEL
	MOVEM J,SWOBK
	MOVEM D,SWOMMP
	AOS CIRPSW	;SWOP1A WILL SOS IT BEFORE RETURNING
	PUSHJ P,SWOP1A	;WILL RETURN THE MMP ENTRY SINCE NO USERS ARE LINKED TO IT
	 JRST 4,.	;EXEC PAGES STILL POINT TO PAGE, ALTHOUGH UPGRTN FLUSHED THEM
	CONO PI,CLKON
	POP P,U
	JRST RHUSRA

;HERE TO RETURN AN MMP ENTRY AND SOS THE TUT, AT P.I. LEVEL
;IF TUT OR CIRPSW IS LOCKED, PUTS ON MMPFS2 AND WAKES UP CORE JOB
;OTHERWISE, CLEARS OUT AND PUTS ON MMPFS
;A -> MMP ENTRY, CLOBBERS B,D,E,I

RETMMP:	PI2SAF
	LDB I,[$MMPUN,,(A)]
	SKIPGE CIRPSW
	 SKIPGE QTUTO(I)
	  JRST RETMM1	;CAN'T SET LOCKS, LET CORE JOB DO IT
RETMM0:	HLRZ D,1(A)
	PUSHJ P,TUTPNT	;SOS THE TUT
	CAIGE B,TUTMNY
	 SOJL B,[JRST 4,.]
	DPB B,D
	JUMPN B,RETMM7
	MOVE E,QTUTO(I)	;RETURNING BLOCK TO FREE, AOS APPROPRIATE FREE COUNT
	HLRZ D,1(A)
	CAML D,QSWAPA(E)
	 AOSA QSFT(I)
	  AOS QSFTS(I)
RETMM7:	MOVSI D,MMPSHR
	TDNN D,(A)
	 JRST RETMM6
	HLRZ D,1(A)	;REMOVE FROM SHAREABLE PAGE HASH TABLE
	HRL D,I
	IDIVI D,SHRHSL
	MOVEI D,SHRHSH-1(E)
RETMM5:	MOVE E,D
	HRRZ D,1(D)
	JUMPE D,[JRST 4,.]	;NOT IN TABLE OR MIS-HASHED?
	CAME D,A
	 JRST RETMM5
	HRRZ D,1(D)
	HRRM D,1(E)
RETMM6:	MOVE D,A
	SOS MMPCNT
	AOS MMPFR
MMPRT1:	EXCH D,MMPFS	;ADD THIS ENTRY ONTO THE FRONT OF
	MOVE A,MMPFS	;THE LIST OF AVAILABLE MMP ENTRIES
	MOVEM D,(A)	;CLEAR LH OF FIRST WORD OF ENTRY
	SETZM 1(A)	;CLEAR SECOND WORD OF ENTRY
	POPJ P,

RETMM1:	MOVE D,A	;ADD THIS ENTRY TO LIST OF ONES TO HACK LATER
	EXCH D,MMPFS2
	HRRM D,(A)	;ONLY CLOBBER THE CIRC PNTR, WHICH POINTS TO SELF
	SKIPN D
	 AOS NCORRQ	;LIST WAS EMPTY, AWAKEN CORE JOB
	POPJ P,

;CORE JOB COMES HERE WHEN MMPFS2 IS NON-ZERO

RETMM2:	SOS NCORRQ
	PUSHJ P,SWTL
	    CIRPSW
	PUSHJ P,RETMM4
	PUSHJ P,LSWPOP
	JRST CORJOB

RETMM4:	MOVEI A,0	;HERE, WITH CIRPSW LOCKED, TO FINISH RETURNING MMP ENTRIES
	EXCH A,MMPFS2
RETMM3:	JUMPE A,CPOPJ
	LDB I,[$MMPUN,,(A)]
	PUSHJ P,QTLOCK
	HRRZ H,(A)
	PUSHJ P,RETMM0
	PUSHJ P,QTULK
	MOVE A,H
	JRST RETMM3

;GET AN MMP ENTRY, RET. IDX IN R, ADDR IN TT.
;CLEARS BOTH WDS OF MMP ENTRY. CLOBBERS NO ACS.
;SKIPS IF SUCCESSFUL.  DOESN'T SKIP IF NO LOW CORE FOR NEW MMP PAGE.
;YOU BETTER ALREADY HAVE COMMITTED THE MMP ENTRY VIA SOSGE MMPFR

GMMPP:	HRRZ TT,MMPFS
	JUMPE TT,GMMP1	;FREE LIST IS EMPTY
	CAMGE TT,MMPEAD
	 JRST 4,.	;IDX GOT ON FREE LIST; SHOULD BE ADDR
	MOVE R,TT
	SUB R,MMPEAD
	CLEARM 1(TT)
	HRL TT,(TT)
	CLEARM (TT)
	HLRZM TT,MMPFS
	AOS MMPCNT	;1 MORE MMP ENTRY IN USE.
	JRST POPJ1

GMMP1:	SKIPN MMPFS2
	 JRST GMMP4
	PUSH P,A	;PROTECT ACS CLOBBERED BY RETMM4
	PUSH P,B
	PUSH P,D
	PUSH P,E
	PUSH P,H
	PUSH P,I
	PUSH P,T
	PUSHJ P,RETMM4
	POP P,T
	POP P,I
	POP P,H
	POP P,E
	POP P,D
	POP P,B
	POP P,A
	JRST GMMPP

GMMP4:	PUSH P,A	;CREATE ANOTHER PAGE-FULL OF MMP ENTRIES
	PUSH P,B
	PUSH P,D
	PUSHJ P,TCALL
	  ;JRST IOMQ	;ALLOCATE LOW CORE SO GETS DUMPED WITH CRASHES
	  JRST NMMRQ	;IOMQ LOSES BECAUSE WE GET CALLED WITH MEMFRZ LOCKED
			;NMMRQ ISN'T QUITE RIGHT, BECAUSE OF NCBCOM.  FIX LATER. ---
	 JRST GMMP3	;NO LOW CORE AVAIL NOW
	MOVEI B,MUMMP
	DPB B,[MUR,,MEMBLT(A)]
	MOVEI B,2000
	ADDM B,MMPMX	;INCREMENT MAX ALLOWABLE ADDR OF MMP
	AOS B,MMPNP
	CAILE B,NMMP
	 JRST 4,.	;SOMEONE DIDN'T CHECK MMPFR?
	MOVEM A,MMMPG-1(B)
	TRO A,600000+PMCSHM
	DPB A,MMPPPP-1(B) ;PUT NEW MMP PAGE INTO EXEC MAP
	MOVE D,USER
	CLRPGM (D)
	SOS B
	LSH B,10.
	HRLI B,-1000
GMMP2:	MOVEI D,MMP(B)	;PUT ALL ENTRIES IN PAGE ON THE FREE LIST
	PUSHJ P,MMPRT1
	AOS B
	AOBJN B,GMMP2
	POP P,D
	POP P,B
	POP P,A
	JRST GMMPP

GMMP3:	POP P,D
	POP P,B
	POP P,A
	POPJ P,

;HERE IF TRANSIENT CONDITION PREVENTS GRABBING PAGE RIGHT NOW

CORS18:	MOVE T,LSWPR+LUBLK
	CAIE T,MEMFRZ
	 JRST 4,.
	PUSHJ P,LSWPOP		;MEMFRZ
	PUSHJ P,UDELAY
	PUSHJ P,ACMTC
	PUSHJ P,SWTL
	    MEMFRZ

;GROW A JOB'S CONTIGUOUS MEMORY.  USED ONLY FOR SYSTEM JOB THESE DAYS.

CORS2:
IFN XGP,[
	SKIPL XGPUSR	;AVOID EXPANDING INTO XGP PAGE.
	 PUSHJ P,UFLS
]
	LDB J,[121100,,HUSRAD(U)]
	LDB E,[MUR,,MEMBLT(J)]
	CAIN E,MUFR
	 JRST COSFR	;FREE PAGE, TAKE IT.
	CAIE E,MUINP
	CAIN E,MUFRT
	 JRST CORS18	;WAIT UNTIL IT STABILIZES
	CAIN E,MUSWPG
	 JRST CORS18	;WAIT UNTIL IT GETS WHERE IT'S GOING
	CAIE E,MURUSR	;USER PAGE, SHUFFLE IT AWAY.
	 JRST 4,.	 ;SHOULDN'T HAVE TO SHUFFLE SYSTEM PAGES.

;SHUFFLE A USER PAGE
CORS4:	PUSHJ P,TCALL
	    JRST HMEMRQ	;GET FREE PAGE TO SHUFFLE IT INTO
	 JRST 4,.	;THERE OUGHT TO BE ONE
	PUSHJ P,CORS5
	JRST CBMRT

;Shuffle user page in J into page in A
;Clobbers C,D,E,H,I,Q,U,T
CORS5:	MOVE D,A
	SKIPGE E,MMSWP(J)
	 JRST 4,.	;BLOCK IS ON SWAP OUT LIST (??)
	TRNN E,-1
	 PUSHJ P,CORS6	;SHUFFLING A POSSIBLY LOOSE PAGE, FIX POINTERS
	SETOM DLSRCH	;CAN'T BE BEING SWAPPED OUT ETC BECAUSE SWAPOUT
	PUSHJ P,UCPRL7	;BLOCKS HAVE MUR=MU23B, AND CIRPSW IS SIEZED
	  SETZ CORSTU	;STOP DIRECT TO MEM DEVICES AND FIX USER MAPS
	TLC C,200	;CHANGE TO 20 BIT BYTE 
	DPB D,C		;RELOCATE PTR TO MEMPNT ENTRY
	PUSHJ P,CMOVE1	;MOVE CONTENTS OF BLOCK
	MOVSI C,-NEXPGS
	MOVE T,[442200,,EXEUMP]
	PUSHJ P,CORPS1	;FIX ANY EXEC PAGE MAP PNTRS TO THIS PAGE
	PUSHJ P,UCPRL4
	  SETZ DEVSTR	;RESTART DIRECT TO MEM DEVICES
	SETZM DLSRCH	;MAPS ARE CONSISTENT AGAIN, LET USERS RUN
	POPJ P,

CORSTU:	PUSHJ P,DEVSTP	;STOP DIRECT-TO-MEM DEVICES
	MOVE A,I	;COMPUTE USER'S MAP ENTRY LOCN
	PUSHJ P,UPLC
	LDB C,T
	TRNN C,600000
	 POPJ P,	;PAGE SWAPPED IN BUT NOT YET LINKED UP
	ANDI C,PMRCM
	CAIE C,(J)
	 JRST 4,.
	TLC T,2200#<PMRCAD&7700>	;CHANGE TO ADDRESS REAL CORE ADR FIELD
	DPB D,T				;RELOCATE USER'S MAP
	POPJ P,

COSFR:	MOVE D,J
	PUSHJ P,MEMMF
CBMRT:	MOVEM J,SJSPG	;SAVE PAGE # RESERVED
	JRST CORM1B

;CORE SHUFFLER, TO KEEP LOW MEMORY FREE
CFLM1:	PUSHJ P,SWTL
	    CIRPSW
	PUSHJ P,SWTL
	    MEMFRZ
	PUSHJ P,CFLM2
	PUSHJ P,LSWPOP		;MEMFRZ
	JRST LSWPOP		;CIRPSW

CFLM2:	MOVEI J,LIOBLK		;Scan through "low" memory
	SKIPE MEMHPT		;Make sure there is likely to be free high mem
	 JRST CFLM4
	AOS SWPOPR		;Kick swapper more than kicked already
	POPJ P,			;And give up

CFLM3:	CAIN J,128.
	 MOVEI J,128.+NEXPGS
	CAIL J,256.		;Assume USEMDM is always on (safe assumption)
	 POPJ P,		;All done, couldn't find anything
CFLM4:	LDB A,[MUR,,MEMBLT(J)]
	CAIE A,MURUSR
	 AOJA J,CFLM3
	PUSHJ P,TCALL
	    JRST HMEMRQ		;Get free page to shuffle it into
	 POPJ P,		;No memory free, give up for now
	PUSHJ P,CORS5		;Shuffle page into new memory
	MOVE A,J		;Free old page
	PUSHJ P,CMEMR
	MOVE A,LMEMFR
	CAMGE A,MINCOR
	 AOJA J,CFLM3
	POPJ P,			;Freed sufficient low pages, stop now

;STOP DIRECT TO MEM DEVICES

DEVSTP:
IFN VIDP,[
	CAMN U,SCNUSR	;STOP DIRECT MEM DEVICES
	 PUSHJ P,SCNSTC	;STOP DIRECT VIDI INPUT
]
IFN 340P\E.SP,[
	CAMN U,DISUSR	;STOP DISPLAY IF THIS GUY HAS IT
	 PUSHJ P,DCRSTP
]
	POPJ P,

;RESTART DIRECT TO MEM DEVICES

DEVSTR:	CLRPGM +LUBLK	;CLEAR PAGE MAP ASSOC REGS IN HARDWARE
IFN VIDP,[
	CAMN U,SCNUSR	;RESTART DIRECT MEM DEVICES
	 PUSHJ P,SCNRST	;RESTART DIRECT VIDI INPUT
]
IFN 340P\E.SP,[
	CAMN U,DISUSR
	 PUSHJ P,DCRRST	;RESTART DISPLAY
]
	POPJ P,

;HERE TO RELOCATE EXEC PAGES WHICH POINT TO PAGE IN J

CORPS1:	MOVEI I,0
CORPS4:	ILDB Q,T
	TLC T,2200#<PMRCAD&7700>	;CHANGE SIZE FIELD TO ADDRESS REAL CORE ADR
	ANDI Q,PMRCM
	CAME Q,J
	 JRST CORPS3
	AOS I		;COUNT # OF EXEC PGS POINTING TO THIS ONE
	DPB D,T		;RELOCATE EXEC PG PNTR
CORPS3:	TLC T,2200#<PMRCAD&7700>	;CHANGE SIZE BACK TO 22
	AOBJN C,CORPS4
	HLRZ T,MMSWP(D)
	CAMN T,I	;CHECK COUNT OF EXEC PAGES
	 POPJ P,	;COUNTED CORRECTLY, WIN

IFN E.SP,[		;SEE IF E&S CAN ACCOUNT FOR SOME PAGES
	MOVSI Q,-MXDISP		;SET UP INDEX
	CAMN J,DISSWP(Q)	;J/ OLD INDEX, D/ NEW
	 AOJA I,E.SX2		;COUNT I IF FOUND, AND RECHECK COUNT
	AOBJN Q,.-2		;ELSE CONTINUE SEARCH
	JRST 4,.		;NOT FOUND, BOMB
E.SX2:	MOVEM D,DISSWP(Q)	;RELOCATE PAGE
	AOS E.SREL		;# PAGES RELOCATED (FOR DEBUGGING)
	CAMN T,I		;SKIP IF COUNT IS STILL BAD
	 POPJ P,		;E&S COUNT WAS CULPRIT -- HAPPY AGAIN
]
IFN XGP,[
	PUSH P,A
	PUSH P,B
	MOVE B,J
	PUSHJ P,XGPBIT
	TDNE A,XGPMTB(B)
	 AOS I
	CAMN I,T
	 JRST POPBAJ
]
	JRST 4,.	;EXEC PGS COUNT OFF

CORS6:	MOVE T,FLOOSP	;FIX POINTERS TO LOOSE PAGE BEING SHUFFLED
CORS7:	SKIPN C,T
	 JRST CORS8
	LDB T,[MLO,,MEMBLT(C)]
	CAME T,J
	 JRST CORS7
	DPB D,[MLO,,MEMBLT(C)]
CORS8:	CAMN J,FLOOSP
	 MOVEM D,FLOOSP
	CAMN J,LLOOSP
	 MOVEM D,LLOOSP
	POPJ P,

;RUN AROUND CIRC LIST STRUCTURE
;WORD AFTER CALL IS POINTER TO ROUTINE TO BE CALLED FOR EACH ITEM IN LIST ACCORDING
;TO FLAGS IN LH: 4.9 USER PAGE (U=USER,I=PG#), 4.8 MMP (T=IDX), 4.7 MEMPNT (T=PG#)
;CALLED ROUTINE MUSTN'T CLOBBER C,H; NOR U,I IF A USER PAGE; NOR T IF MEMPNT.
;RETURNS IN C BYTE POINTER TO PLACE THAT POINTS TO
;STARTING BYTE POINTER THAT WAS IN C
;ENTRIES:
; UCPRL - STARTING BYTE POINTER IN C
; UCPRL4 - STARTING CORE PAGE # IN D
; UCPRL7 - STARTING CORE PAGE # IN J
;PDL DEEPENED BY TWO PUSH'S AND TWO PUSHJ'S.
;---WARNING--- : CLOBBERS U ------- ALSO CLOBBERS H,T,I

UCPRL7:	SKIPA C,[2200,,MEMPNT(J)]
UCPRL4:	MOVE C,[2200,,MEMPNT(D)]
UCPRL:	MOVE H,@(P)
	HRRI C,@C
	TLZ C,37
	PUSH P,C
	PUSH P,C
	JRST UCPRL5

UCPRL2:	CAMN C,-1(P)
	 JRST UCPRL6
	MOVEM C,(P)
UCPRL5:	LDB T,C
	JUMPE T,[JRST 4,.]
	TRZE T,400000
	 JRST UCPRL1
	LDB I,[1000,,T]	;PAGE #
	LDB U,[101100,,T]	;USER #
	IMULI U,LUBLK
	CAML U,USRHI
	 JRST 4,.
	SKIPGE H
	 PUSHJ P,(H)
	MOVEI C,UPGCP(U)
	ROT I,-1
	ADDI C,(I)
	HRLI C,222200
	SKIPGE I
	 HRLI C,2200
	JRST UCPRL2

UCPRL1:	TRZE T,200000
	 JRST UCPRL3
	CAML T,MMPMX
	 JRST 4,.	;MMP ADR OUT OF RANGE
	MOVSI C,2200	;MMP
	HRR C,MMPEAD
	ADDI C,(T)
	TLNE H,200000
	 PUSHJ P,(H)
	JRST UCPRL2

UCPRL3:	CAIL T,TSYSM
	 JRST 4,.	;MEMBLT ADR OUT OF RANGE
	TLNE H,100000	;MEMPNT
	 PUSHJ P,(H)
	MOVE C,[2200,,MEMPNT]
	ADDI C,(T)
	JRST UCPRL2

UCPRL6:	MOVE C,(P)
	SUB P,[2,,2]
	JRST POPJ1
;DISCARD IDLE DISK UFD'S.

UFDFF:	PUSHJ P,SWTL
	    UDRSW
	MOVEI C,MEMR
	PUSHJ P,QDFLS
	JRST UTBFF5

;FLUSH "UTAPE" (200-WD) BUFFERS
;TRY TO COMPACTIFY INTO FEWER PAGES BY DELETING PAGES CONTAINING
;ONLY FREE ONES AND BY MOVING NETWORK BUFFERS AROUND.  OTHER KINDS
;OF BUFFERS DON'T STAY AROUND VERY LONG AND ARE HARD TO MOVE
;WITHOUT INTRODUCING TIMING/PCLSR'ING BUGS.

UTBFF:	PUSHJ P,SWTL
	  MEMFRZ
	MOVSI J,-TSYSM
UTBFF3:	LDB R,[MUR,,MEMBLT(J)]
	CAIN R,MUIOB
	 PUSHJ P,UTBFF2
	AOBJN J,UTBFF3
UTBFF5:	SOS NCORRQ
	PUSHJ P,LSWPOP
IFN CHAOSP, PUSHJ P,CHCLN	;ALSO, CLEAN UP CHAOS NET BUFFERS
IFN INETP, PUSHJ P,PKBCLN	; Clean up network packet buffers
;SWAP OUT ALL LOOSE PAGES.  THE REASON THIS IS DONE IS THAT IF THE
;SYSTEM LOAD IS LIGHT LOOSE PAGES FOR DELETED INQUIR DATA BASE FILES
;CAN STAY AROUND INDEFINITELY, TYING UP DISK SPACE.
;SWAPPING OUT LOOSE PAGES DOES NOT CAUSE ANY DISK I/O.
;SWPOPG MAY NON-SKIP RETURN IF CIRPSW OR A TUT IS LOCKED,
;IN WHICH CASE WE GIVE UP UNTIL THE NEXT 2-MINUTE CLOCK.
UTBFF6:	CONO PI,CLKOFF
	SKIPN A,FLOOSP		;GET A LOOSE PAGE
	 JRST UTBFF7
	MOVNI C,1
	PUSHJ P,SWPOPL		;SWAP OUT EVEN IF LOCKED (SHOULDN'T BE)
	 JRST UTBFF7		;COULDN'T SWAP OUT, GIVE UP FOR NOW
	CONO PI,CLKON		;ALLOW CHANCE FOR AN INTERRUPT
	JRST UTBFF6

UTBFF7:	CONO PI,CLKON
	JRST CORJOB

;RH(J) HAS PAGE NUMBER OF A BLOCK OF 200-WD BUFFERS
UTBFF2:	LDB R,[MNUMB,,MEMBLT(J)] ;GET LIST OF IOBFT ENTRIES IN THIS BLOCK
	CLEARB Q,TT
COSIO1:	MOVSI E,200000		;ALLOC INH ALL BUFFERS IN BLOCK
	IORM E,IOBFT(R)
	LDB E,[IOCH,,IOBFT(R)]
	CAIE E,77
	 AOS Q			;COUNT NUMBER USED FOR SOMETHING
	CAIL E,NFNETC
	 CAIL E,NFNETC+NNETCH
	  CAIA
	   AOS TT		;COUNT NUMBER USED FOR NETWORK
	LDB R,[IOLC,,IOBFT(R)]
	CAIE R,377
	 JRST COSIO1
	JUMPE Q,COSIO3		;IF ALL BUFFERS FREE, FLUSH THIS PAGE
	CAME Q,TT
	 JRST UTBFF1		;CONTAINS NON-NET BUFFERS, LEAVE ALONE
	MOVEI E,0
	EXCH E,UTTBF
	CAIL E,8		;IF THERE ARE ENOUGH FREE IN OTHER BLOCKS
	 JRST CISHUF		;THEN GO SHUFFLE THE NET BUFFERS
	EXCH E,UTTBF
UTBFF1:	LDB R,[MNUMB,,MEMBLT(J)]	;ABANDON IDEA OF FLUSHING THIS BLOCK
	MOVSI E,200000			;UN-INHIBIT THE BUFFERS..
UTBFF4:	ANDCAM E,IOBFT(R)
	LDB R,[IOLC,,IOBFT(R)]
	CAIE R,377
	 JRST UTBFF4
	POPJ P,			;RETURN OUT OF UTBFF2
;SHUFFLE BUFFERS
;COME HERE WITH UTTBF SET TO 0 AND OLD VALUE IN E
;LEAVE UTTBF 0 WHILE SHUFFLING SO NO ONE ELSE CAN ALLOCATE

CISHUF:	PUSH P,E
	LDB R,[MNUMB,,MEMBLT(J)]
CISHF1:	LDB Q,[IOCH,,IOBFT(R)]
	CAIN Q,77
	 JRST CISHF2		;FREE, IGNORE
	CAIL Q,NFNETC
	CAILE Q,NFNETC+NNETCH
	 JRST 4,.		;SOME RANDOM UNSHUFFABLE BUFFER
	PUSHJ P,CINET
CISHF2:	LDB R,[IOLC,,IOBFT(R)]
	CAIE R,377
	 JRST CISHF1
	POP P,UTTBF		;ALLOW ALLOC AGAIN.  THIS MEM BLOCK NOW
				;CONTAINS 8 FREE, ALLOC INH BUFFERS.
				;SO FALL INTO COSIO3 TO FLUSH THEM.
;FLUSH ALL 8 BUFFERS.

COSIO3:	LDB R,[MNUMB,,MEMBLT(J)]
	MOVEI TT,7
COSIO4:	LDB Q,[IOCH,,IOBFT(R)]
	CAIE Q,77
	 JRST 4,.		;BUFFER WAS SUPPOSED TO BE FREE??
	MOVEI Q,UTFS-IOBFT	;PNTR TO F.S. LIST
	SOS UTTBF		;SOON WILL BE ONE LESS FREE UTAPE BUFFER
	CONO PI,UTCOFF
COSIO5:	MOVE E,Q		;REMOVE IOBFT ENTRY IN R FROM F.S. LIST
	LDB Q,[IOLO,,IOBFT(Q)]
	CAIN Q,377
	 JRST 4,.		;IT WASN'T IN THE LIST
	CAME Q,R
	 JRST COSIO5

	LDB Q,[IOLO,,IOBFT(R)]
	DPB Q,[IOLO,,IOBFT(E)]
	MOVE A,R		;GIVE IOBFT ENTRY BACK TO LIST OF UNUSED IOBFTS
	LDB R,[IOLC,,IOBFT(R)]
	PUSHJ P,IOBR
	CONO PI,UTCON
	CAIE R,377
	 SOJA TT,COSIO4

	JUMPN TT,[JRST 4,.]	;BLOCK DIDN'T CONTAIN 8 BUFFERS
	MOVNI A,8
	ADDB A,UTTLB
	CAMGE A,[-NUTIC-NUTOC]
	 JRST 4,.
	PUSHJ P,FSCMP
	HRRZ A,J		;THIS BLOCK OF MEMORY IS FREE NOW
	JRST CMEMR		;AND RETURN OUT OF UTBFF2

;EXCHANGE BUFFER IN R WITH SOME FREE BUFFER, RETURNED IN A
;CALL WITH UCTOFF, CHANNEL NUMBER IN Q, TURNS UTCON

COSIMG:	MOVEI D,NFNETC(Q)	;CHNL NO TO CONS FOR
	AOS UTTBF		;UNRESERVE ONE BUFFER MOMENTARILY
	PUSHJ P,IUTCONS
	 JRST 4,.
	CONO PI,UTCON
	LDB TT,[IOSA1,,IOBFT(R)]	;TRANSFER BUFFER R TO BUFFER A
	LDB T,[IOSA1,,IOBFT(A)]
	HRL T,TT
	LSH T,7
	HRRZ TT,T
	BLT T,177(TT)
	EXCH R,A
	CONO PI,UTCOFF
	PUSHJ P,IBRTN		;RETURN THE OLD BUFFER
	SOS UTTBF		;BUT RESERVE IT
	EXCH R,A
	JRST UTCONJ

;SHUFFLE OFF A NCP NETWORK BUFFER
;R HAS IOBFT INDEX, Q HAS CHANNEL NUMBER, E MUST BE PRESERVED

CINET:
IFE NCPP,JRST 4,.
IFN NCPP,[
	SUBI Q,NFNETC		;GET IMSOC INDEX
	HRRZ A,IMSOC1(Q)	;USER WHO OWNS THIS BUFFER
	MOVSI T,200000
	TDNE T,IMSOC1(Q)	;SKIP OVER USER STOP IF BEING CLOSED
	 TROA A,-1		; SINCE USER CAN'T REFERENCE BUFFER ANY MORE
	  PUSHJ P,RPCLSR	;AND LEAVE A=USER # STOPPED OR 0,,-1 IF NONE
	MOVSI T,200000		;MUSTN'T BE ACTIVE AT PI LEVEL
	PUSHJ P,LWAIT
	  TDNE T,IMSOC6(Q)
	SKIPN IMSOC6(Q)	;LWAIT RETURNS WITH NETOFF
	 JRST CINET2		;BUFFER HAS BEEN RETURNED
	MOVSI T,400000		;LOCK THE BUFFER SO PI LEVEL WON'T TOUCH
	IORM T,IMSOC6(Q)
	LDB T,[221000,,IMSOC6(Q)]
	CAIE T,(R)
	 JRST 4,.		;IOBFT ENTRY POINTS TO WRONG CHANNEL
	PUSH P,A		;SAVE INDEX OF STOPPED USER
	PUSHJ P,COSIMG		;COPY BUFFER
	LDB TT,[IOSA,,IOBFT(A)]
	LSH TT,6
	MOVE T,TT
	HRRZ D,IMSOC6(Q)
	SUB T,D			;OFFSET NEW BUFFER MINUS OLD
	HRL TT,A
	DPB TT,[003200,,IMSOC6(Q)] ;STORE NEW BUFFER ADDR, LEAVE FLAGS ALONE
	ADDM T,IMSBFE(Q)	;RELOCATE VARIOUS POINTERS
	ADDM T,IMSMPP(Q)
	ADDM T,IMSPIP(Q)
	MOVE TT,IMSOC2(Q)
	TRNN TT,1
	 AOSA IMNISH
	  AOS IMNOSH
	CONO PI,NETOFF
	MOVE TT,IMSOC6(Q)
	TLNN TT,100000		;SKIP IF INPUT OCCURRED WITH BUFFER LOCKED
	 JRST CINET1
IFE DMI,[
	MOVE TT,IMPSVP		;RESTART INPUT
	MOVEM TT,IMPPIA
	CONO IMP,(TT)
]
IFN DMI,CONO FI,FIIN+NETCHN*11
CINET1:	MOVSI TT,500000		;UNLOCK THE BUFFER, CLEAR INPUT WITH LOCK FLAG
	ANDCAM TT,IMSOC6(Q)
	PUSHJ P,IMPIOS		;RESTART OUTPUT
	POP P,A			;AND FALL INTO CINET2 TO RESTART USER
CINET2:	CONO PI,NETON
	JRST NJUPCL		;RESTART USER IF ONE WAS STOPPED
] ;END IFN NCPP

;FREE BLOCKS THAT BECAME FREE AT INT LEVEL.
ACMTC:	SKIPN MEMFP1	;ANY BLKS BECAME FREE AT INT LVL?
	 POPJ P,
	CONO PI,UTCOFF
	SKIPL MEMFRZ	;IF MEMFRZ IS LOCKED, CAN'T DO THIS.  JUST
	 JRST UTCONJ	;HOPE ENOUGH CORE IS FREE. MUST BE BETTER WAY!
	MOVE A,MEMFP1	;GET # OF ONE OF THEM,
	LDB B,[MLO,,MEMBLT(A)]	;REMOVE IT FROM LIST OF SUCH BLOCKS
	HRRZM B,MEMFP1
	LDB B,[MUR,,MEMBLT(A)]
	CAIE B,MUFRT
	 JRST 4,.
	PUSHJ P,MEMR
	JRST ACMTC

;COPY A PHYSICAL PAGE'S DATA FROM PAGE (J) TO PAGE (D)
CMOVE1:	MOVE C,MEMBLT(J)
	MOVEM C,MEMBLT(D)
	CLEARM MEMBLT(J)
	MOVE C,MEMPNT(J)
	MOVEM C,MEMPNT(D)
	CLEARM MEMPNT(J)
	MOVE C,MMSWP(J)
	MOVEM C,MMSWP(D)
	HRRZ A,D
	CAIGE A,SYSB
	 JRST 4,.
	TRO D,600000+PMCSHM
	TRO J,600000+PMCSHM
	DPB D,[.CORJT+EXEUMP]
	DPB J,[.CORJF+EXEUMP]
	TRZ D,600000+PMCSHM
	TRZ J,600000+PMCSHM
	CLRPGM +LUBLK
	MOVE A,[400000+CORJF*2000,,400000+CORJT*2000]
	BLT A,400000+CORJT*2000+1777
	MOVEI A,0
	DPB A,[.CORJT+EXEUMP]
	DPB A,[.CORJF+EXEUMP]
	POPJ P,

MEMMF:	LDB A,[MUR,,MEMBLT(D)]
	CAIE A,MUFR
	 JRST 4,.
	HRRZ A,D
	PUSHJ P,TCALL
	  JRST MPOUT
	POPJ P,

UDELAY:	PUSH P,T
	MOVE T,TIME
	ADDI T,15.	;SLEEP 1/2 SEC. (REALLY SHOULD DO A LOW
	CAMLE T,TIME	;PRIORITY UNBLOCK IF SYS LIGHTLY LOADED)
UDELA1:	 PUSHJ P,UFLS
	JRST POPTJ

CZRR:	PUSH P,A
	CAIGE A,SYSB	;CORE ZEROER
	 JRST 4,.
	TRO A,600000+PMCSHM
	DPB A,[.CORJT+EXEUMP]
	CLRPGM +LUBLK
	CLEARM 400000+CORJT*2000
	MOVE A,[400000+CORJT*2000,,400000+CORJT*2000+1]
	BLT A,400000+CORJT*2000+1777
	MOVEI A,0
	DPB A,[.CORJT+EXEUMP]
	JRST POPAJ

;ROUTINES TO ALLOCATE BLOCKS OF MEMORY
;CALL ONLY AT UTC LEVEL OR WITH UTC OFF

OVHMTR ALC	;CORE ALLOCATION

;SEE IF CAN ALLOCATE MEMORY
MQTEST:	MOVE A,MEMFR
	SUB A,NCBCOM
	JUMPLE A,CPOPJ
	SKIPLE MEMFR
	 SKIPL MEMFRZ
	  POPJ P,
	JRST POPJ1

;ALLOCATE PREFERRING HIGH MEMORY, FOR RANDOM USER PAGE.  SHUFFLEABLE PAGE OK.
HMRQC:	PUSHJ P,MQTEST
	 POPJ P,
HMEMRQ:	PUSH P,B
	PUSH P,E
	HRREI B,MEMHPT-MEMBLT
HMRQ3:	LDB A,[MLO,,MEMBLT(B)]
	JUMPE A,HMRQ1	;HIGH HALF FULL TRY LOW
	CAIL A,SYSB	;DON'T ALLOCATE PART OF THE SYSTEM
	SKIPGE MEMBLT(A) ;DON'T ALLOCATE IF LOCKED
	 SKIPA B,A	;THIS PAGE NOT AVAIL, TRY NEXT
	  JRST IMRQ8	;GOBBLE IT
	JRST HMRQ3

HMRQ1:	POP P,E
	POP P,B
	JRST NMMRQ	;THAT DIDNT WORK, TRY LOW HALF

;ALLOCATE A BLOCK OF MEM FOR 200-WORD BUFFERS
UIMRQ:	MOVE A,IOBFC
	CAIGE A,8
	 POPJ P,	;NOT ENOUGH ROOM IM IOBFT
	MOVE A,MEMFR
	SUB A,NCBCOM
	CAIG A,3
	 POPJ P,

;GET A BLOCK THAT WON'T BE SHUFFLED, AND IS DIRECTLY ACCESSIBLE.
IOMQ:	PUSHJ P,MQTEST	;GET LOW OR MEDIUM MEMORY FOR I/O
	 POPJ P,

;ALLOCATING LOW MEM
NMMRQ:	MOVEI A,0		;MEMFP = MEMBLT+0
IMRQ7:	PI2SAF
	PUSH P,B
	PUSH P,E
IMRQ2:	LDB A,[MLO,,MEMBLT(A)]
	JUMPN A,IMRQ3
	PUSH P,C
	PUSH P,H
	PUSH P,TT
	MOVEI C,IMEMR
	SKIPGE UDRSW
	 PUSHJ P,QDFLS	;TRY FLUSHING DISK DIRS
	POP P,TT
	POP P,H
	POP P,C
	MOVEI A,0
IMRQ6:	LDB A,[MLO,,MEMBLT(A)]
	JUMPE A,IMRQR	;NO MEM AVAIL IN LOW HALF, TAKE NON-SKIP RETURN
	SKIPGE MEMBLT(A)
	 JRST IMRQ6
	JRST IMRQ9

MPOUT1:
IMRQR:	POP P,E
	JRST POPBJ

IMRQ3:	SKIPGE MEMBLT(A)
	 JRST IMRQ2	;LOCKED LOOK FOR ANOTHER
IMRQ9:	TDZA B,B	;GOBBLE FROM LOW
IMRQ8:	 MOVNI B,1	;GOBBLE FROM HIGH
	AOS -2(P)	;CAUSE RETURN TO SKIP
	LDB E,[MUR,,MEMBLT(A)]
	CAIN E,MUFR
	 JUMPN A,IMRQ4
	JRST 4,.	;BLOCK GOT PUT ON FREE STORAGE LIST WITHOUT USAGE FIELD GETTING "FREE"
;ROUTINES FOR RETURNING MEMORY
IMEMR:	PI2SAF		;HERE OTHERWISE (SEE BELOW)
	CAIGE A,TSYSM
	CAIGE A,SYSB
	 JRST 4,.	;DON'T RETURN PART OF SYSTEM
	SKIPL MEMFRZ
	 JRST IMEMR1
CIMEMR:	PUSH P,B	;ENTER HERE IF OK TO HACK WITH MEM FROZEN
	LDB B,[MUR,,MEMBLT(A)]	;I E CALLING FROM CORE ALLOCATOR
	CAIN B,MUFR
	 JRST 4,.	;ALREADY FREE, LOSSAGE
	SETZM MEMBLT(A)	;INITIALIZE RANDOM FIELDS
	CAIGE A,256.	;HIGH MOBY GOES ON HIGH LIST
	CAIGE A,LIOBLK	;LOW SHUFFLEABLE GOES ON HIGH LIST
	 JRST CIMEM1
	CAIGE A,128.	;LOW NON-SHUFFLEABLE GOES ON LOW LIST
	 JRST CIMEM0
	CAIL A,128.+NEXPGS ;SHADOWS OF EXEC PAGES GO ON HIGH LIST
	 SKIPN USEMDM	;MEDIUM MEMORY GOES ON LOW OR HIGH DEPENDING ON USEMDM
	   JRST CIMEM1
CIMEM0:	LDB B,[MLO,,MEMFP]	;PICK UP HEAD OF APPRO FS LIST
	DPB B,[MLO,,MEMBLT(A)]	;STORE AS LINK OUT OF CURRENT WD
	CAIE B,0	;SKIP IF NO BLOCK PREVIOUSLY ON LIST
	 DPB A,[MLU,,MEMBLT(B)]	;MAKE FORMER HEAD'S BACK PNTR POINT TO CURRENT
	MOVEI B,0	;NO BACK PTR, THIS WILL BE FIRST IN LIST
	DPB B,[MLU,,MEMBLT(A)]
	DPB A,[MLO,,MEMFP]	;STORE THIS AS FREE LIST HEAD
	AOS LMEMFR
CIMEM3:	MOVEI B,MUFR
	DPB B,[MUR,,MEMBLT(A)]	;STORE FREE IN USER
	CLEARM MEMPNT(A)
	AOS MEMFR
	JRST POPBJ

CIMEM1:	LDB B,[MLO,,MEMHPT]	;PICK UP HEAD OF APPRO FS LIST
	DPB B,[MLO,,MEMBLT(A)]	;STORE AS LINK OUT OF CURRENT WD
	CAIE B,0	;SKIP IF NO BLOCK PREVIOUSLY ON LIST
	 DPB A,[MLU,,MEMBLT(B)]	;MAKE FORMER HEAD'S BACK PNTR POINT TO CURRENT
	MOVEI B,0	;NO BACK PTR, THIS WILL BE FIRST IN LIST
	DPB B,[MLU,,MEMBLT(A)]
	DPB A,[MLO,,MEMHPT]	;STORE THIS AS FREE LIST HEAD
	JRST CIMEM3

IMEMR1:	PUSH P,B	;FREE A PAGE WHEN MEMFRZ LOCKED.
	MOVE B,MEMFP1	;ADD IT TO FRONT OF MEMFP1 LIST
	DPB B,[MLO,,MEMBLT(A)]
	HRRZM A,MEMFP1
	MOVEI B,MUFRT	;THEN SAY THIS BLK BECAME FREE WITH MEM FROZEN.
	DPB B,[MUR,,MEMBLT(A)]
	SETZM MEMPNT(A)
	JRST POPBJ

;ROUTINES TO RETURN MEMORY CONTINUED

MGMEMR:	PUSHJ P,TMEMR	;MAG TAPE MEMR
	 MUMGB
	POPJ P,

TMEMR:	PUSH P,B
	LDB B,[MUR,,MEMBLT(A)]
	CAME B,@-1(P)
	 JRST 4,.	;RETURNING BLOCK NOT OF TYPE EXPECTED
	POP P,B
	AOS (P)		;SKIP OVER ARG
MEMR:	CONO PI,UTCOFF
	PUSHJ P,IMEMR
	JRST UTCONJ

CMEMR:	CONO PI,UTCOFF
	PUSHJ P,CIMEMR
	JRST UTCONJ

; ROUTINES TO UNTHREAD BLOCKS FROM FREE LISTS

MPOUT:	PI2SAF
MPOUT2:	JUMPE A,[JRST 4,.]	;ENTER HERE FROM INITIALIZATION IF HOLE FOUND
	PUSH P,B
	PUSH P,E
	CAIGE A,256.	;HIGH MOBY GOES ON HIGH LIST
	CAIGE A,LIOBLK	;LOW NON-SHUFFLEABLE GOES ON HIGH LIST
	 JRST MPOUT4
	CAIGE A,128.	;LOW SHUFFLEABLE GOES ON LOW LIST
	 JRST MPOUT3
	CAIL A,128.+NEXPGS ;SHADOWS OF EXEC PAGES GO ON HIGH LIST
	 SKIPN USEMDM	;MEDIUM MEMORY GOES ON LOW OR HIGH DEPENDING ON USEMDM
MPOUT4:	  SKIPA B,[-1]	;IT'S HIGH MEM
MPOUT3:	   MOVEI B,0	;IT'S LOW MEM

IMRQ4:	PUSH P,B		;0 LOW -1 HIGH
	LDB B,[MLU,,MEMBLT(A)]	;LINK UP
	LDB E,[MLO,,MEMBLT(A)]	;LINK OUT
	JUMPN B,IMRQ5	;JUMP IF NOT FIRST IN LIST
	JUMPE E,IMRQ5	;JUMP IF LAST BLOCK IN LIST
	LDB B,[MUR,,MEMBLT(E)]	;FIRST AND FOLLOWED
	CAIE B,MUFR
	 JRST 4,.	;DOESNT LINK TO A FREE BLOCK
	MOVEI B,0	;PUT BACK 0
IMRQ5:	SKIPE E		;SKIP IF NO BLOCK FOLLOWS
	 DPB B,[MLU,,MEMBLT(E)]	;STORE LINK UP OF PATCHED OUT BLOCK IN LINK OUT BLOCK
	JUMPE B,IMRQ5A
	DPB E,[MLO,,MEMBLT(B)]	;STORE LINK OUT OF PATCHED OUT BLOCK IN LINK UP BLOCK
	POP P,B		;GET BACK WHICH PART OF MEM IT'S IN
	JRST IMRQ5C	

IMRQ5A:	POP P,B		;GET BACK WHICH PART OF MEM IT'S IN
	DPB E,[MLO,,MEMFP(B)] ;THIS WAS FIRST IN FREE LIST, ADJUST LIST HEADER
IMRQ5C:	SKIPL B		;SKIP IF NOT IN LOW HALF
	 SOS LMEMFR	;ADJUST FREE BLOCKS IN LOWER HALF
	SOS MEMFR	;1 LESS FREE BLOCK IN SYSTEM
	SETZM MEMBLT(A)	;CLEAN UP MEMBLT ENTRY FOR CALLER'S SAKE
	MOVEI B,MUINP	;IN PROCESS
	DPB B,[MUR,,MEMBLT(A)]
	JRST MPOUT1

OVHMTR UUO	;MORE MISC UUOS ETC.

TCALL:	CONO PI,UTCOFF
	PUSHJ P,@(P)
	 SKIPA
	  AOS (P)
	JRST UTCOJ1

EBLK

SUBTTL MEMORY ALLOCATION TABLES

IOBFTL:	MXIOB	;BEG FOR GETSYS (MEMORY)
IOBFT:	REPEAT  MXIOB-1,176000,,.RPCNT+1	;MAX DYN ALLOC IO BUFFERS
	176000,,377	;4.9 FREEZE
	;4.8 ALLOC INHIBIT
IOCH==340600	;4.7-4.2 SYS CHN NO 77 => FREE
IOLC==241000	;4.1-3.3 LINK TO NEXT SEQ BUF IN CORE (W/IN 1K BLK)
IOLO==1000	; LINK TO FOLLOWING BUFFER OR
	;SPECIAL STATES LINK OUT
	;-1	LAST BUFFER CURRENTLY FILLED
	;-2   END OF FILE
	;-3   BUFFER ACTIVE AT MAIN PROG LEVEL
	;-4   BUFFER ACTIVE AT PI LEVEL
;IF CHN IS NUTIC+NUTOC (UTAPE FILE DIR) THEN IOLO IS TAPE NO
;CHNLS NUTIC+NUTOC+1 (NFCLC)=>$Q+NCLCH-1 ARE CORE LINK DEVICE
;CHNLS NFNETC => $Q+NNETCH-1 ARE NET CHNLS
SCNCLO==NUTIC+NUTOC+1

IOSA==101400	; BUFFER SA _-6
IOSA1==111300	;ONLY RELEVANT BITS FOR 200 WD BUFFERS


IOBFP:	0	;FREE STG TO IOBFT ENT
IOBFC:	MXIOB-8	;CNT OF AVAIL
			;LEAVE 8 AVAIL SO CORE HACKER CAN NOT RUN OUT

UTFS:	377	;FREE STG PNTR TO 200 WD BUFFERS
UTTLB:	-NUTIC-NUTOC ;TOTAL BUFFERS ALLOCATED TO UTAPES
UTTBF:	0	;TOTAL UT BUFFERS FREE

;EXEC MAPS
IF2,[
EXEUMP=UPGMP+100	;EXEC UPPER MAP LIVES IN SYSTEM JOB'S MAP AREA
EXELMP==UPGMP		;KL10 AND KS10 ALSO NEED EXEC LOWER MAP, + EXISTS
];IF2			;SO USERS CAN COPY PAGES FROM THE SYSTEM JOB

;TABLE OF BYTE POINTERS THAT POINT TO VIDEO BUFFER AREA OF EXEUMP
IFN N11TYS,[
TTCRT:	REPEAT NTVBP,[
		CONC [.TTR]\.RPCNT,+EXEUMP
]
]

IFN PDP6P,[
;DBR FOR REFERENCING PDP6 MEM
PDP6MP:	<LPDP6M/2>_1,,PDPUMP

;PAGE MAP FOR REFERENCING PDP6 MEM
PDPUMP:	REPEAT LPDP6M/2,600000+<PDP6BM_-10.>+2*.RPCNT,,600000+<PDP6BM_-10.>+2*.RPCNT+1
]

IFN 340P,[
DDEXCF:	BLOCK NEXPGS	;-1 IF EXEC PAGE SET UP FOR 340
]

IFN KA10P, EXECMP: 100_1,,EXEUMP	;EXEC DBR
;MEMORY ORGANIZATION

;PAGE 0 ALWAYS BELONGS TO THE SYSTEM AND IS NEVER ALLOCATED OR FREED.
;
;N PAGES OF SYSTEM CODE AND VARIABLES ARE ACQUIRED BY THE SYSTEM JOB AT STARTUP.
;
;N PAGES OF USER-VARIABLE BLOCKS BELONG TO THE SYSTEM JOB.  THESE ARE
;ALLOCATED AND DEALLOCATED AS REQUIRED.  LIOBLK-1 IS THE HIGHEST THIS CAN GO.
;USER PAGES BELOW LIOBLK CAN BE SHUFFLED OUT WHEN THE SYSTEM JOB NEEDS THE CORE.
;
;FROM LIOBLK TO 128K IS THE "LOW HALF."  THESE PAGES ARE DIRECTLY ADDRESSABLE
;IN EXEC MODE AND NEVER NEED TO BE SHUFFLED.  I/O BUFFERS, DISK DIRECTORIES,
;ETC. ARE ALLOCATED IN THESE PAGES.
;
;128K TO 128K+NEXPGS ARE PAGES WHICH CAN'T BE ADDRESSED DIRECTLY FROM
;EXEC MODE BECAUSE THEIR EXEUMP SLOTS ARE USED BY "EXEC PAGES."
;
;THE REST OF THE LOW MOBY, UP TO FDDTPG, IS DIRECT-MAPPED AND
;USED FOR ADDITIONAL "LOW HALF" PAGES.
;
;FDDTPG TO 256K CONTAINS DDT AND THE SYSTEM SYMBOL TABLE.
;
;PAGES ABOVE 256K ARE IN THE "HIGH MOBY".
;
;PAGES NOT IN THE "LOW HALF" (BELOW LIOBLK, SHADOWED BY EXEC, OR HIGH MOBY)
;ARE CONSIDERED TO BE IN THE "HIGH HALF".  USER PAGES PREFER TO GO HERE.
;
;COMPLICATIONS:
; IF USEMDM IS OFF, THE DIRECT MAPPED PAGES IN THE HIGH HALF
; OF THE LOW MOBY ARE CONSIDERED HIGH RATHER THAN LOW.  THIS IS USED
; MOSTLY FOR DEBUGGING, TO CATCH REFERENCES TO RANDOM ADDRESSES.
; THERE CAN BE HOLES IN MEMORY (NXM).
;
;THE MEMBLT TABLE HAS ONE WORD FOR EACH 1K BLOCK OF MEMORY.
;IT SAYS WHAT THAT BLOCK IS USED FOR AND CONTAINS LINKS TO OTHER
;BLOCKS AND OTHER TABLES.  THE MEMPNT AND MMSWP TABLES ALSO CONTAIN
;ONE WORD PER BLOCK AND CONTAIN ADDITIONAL INFORMATION.

FDDTPG:	0	;# OF LOWEST BLOCK USED BY DDT & SYMTAB (SET AT STARTUP)

MEMFR:	0	;# OF FREE BLOCKS IN ALL OF MEMORY.

LMEMFR:	0	;# OF FREE BLOCKS IN LOW LIST (MEMFP).

MINCOR:	8	;TRY TO KEEP THIS MANY PAGES FREE IN LOW MEMORY
		;MUST BE >= 3, SINCE LESSER-PRIORITY CONSUMERS OF
		;MEMORY WAIT IF LMEMFR IS < 3.

MEMFP1:	0	;LIST (THREADED THROUGH MLO, TERMINATED BY 0)
		;OF BLKS THAT BECAME FREE WHILE MEMFRZ WAS LOCKED.

MEMHPT:	0	;FREE LIST OF HIGH HALF PAGES AND HIGH MOBY PAGES
		;AND SHUFFLEABLE LOW HALF PAGES.  MUST BE AT MEMFP-1.
MEMFP::
MEMBLT:	0	;FREE LIST POINTER FOR LOW PGS AND ALSO WD FOR BLOCK 0
	BLOCK TSYSM-1	.SEE BEGF0 ;FILLS THIS IN

;FIELDS IN MEMBLT ENTRY:
;4.9  FREEZE OR ALLOC INHIBIT
;IF 4.9=1, DONT SET UP ANY MORE EXEC PGS POINTING TO THIS ONE
MUR==360500	;4.4-4.8 USAGE CODE
 MURUSR==1	;USER PAGE, MMMPX=MMP INDEX
 MUEX==2	;EXEC (?)
 MUIOB==3	;200 WD BUFFERS, MNUMB=FIRST IOBFT ENTRY IN BLOCK
 MUFR==4	;FREE
 MUINP==5	;IN PROCESS OF BEING ALLOCATED
 MUMGB==6	;MAG TAPE BUFFER, MNUMB=TAPE NO+EOF BIT, MWC=WORD COUNT
 MUMMP==7	;MMP TABLE
 MUDISB==10	;340 DISPLAY BUFFER
 MUFRT==11	;BLOCK RETURNING TO FREE WHEN MEM LOCKED
 MU23B==12	;DISK BUF, MWC=WORD COUNT, MNUMB=CHANNEL
 MU23UD==13	;DISK USER DIR, MNUMB=QSNUD SLOT
 MU23MD==14	;DISK MASTER DIR
 MU23TT==15	;DISK TUT MNUMB=DISK NO.
 MU23LS==16	;DISK COPY OF USER DIR FOR LISTING
 MUHOLE==17	;"HOLE" IN REAL MEM
 MUDDT==20	;"DDT" PAGE
 MUNET==21	;NETWORK "BIG" BUFFER
 MUSWPG==22	;PAGE IN SWAPPING QUEUE, MMMPX=MMP INDEX
 MUCHA==23	;CHAOS NET BUFFERS
 MU23FB==24	.SEE QSFBT	;DISK FREED-BLOCKS TABLES
 MUPKT==25	; Net packet buffers
 MUDVB==26	;Semi-static device IO buffer page
;ADD NEW MUR TYPES HERE ^
MURMAX==27	;HIGHEST VALID CODE + 1

MWC==221400	;3.1-4.3 WORD COUNT IN I/O BUFFERS

MLU==221400	;3.1-4.3 LINK UP FOR DOUBLY-THREADED FREE LIST

MNUMB==140600	;2.4-2.9 MAGIC NUMBER SEE COMMENTS UNDER MUR ABOVE

MMMPX==142200	;2.4-4.3 MMP INDEX IN USER PGS + SWAP BUFFERS

MLO==001400	;1.1-2.3 LINK TO NEXT PAGE IN A LIST
		;0 = END OF LIST
		;UNLIKE IOLO AND PREVIOUS VERSION OF MLO, THERE ARE NO MAGIC NEGATIVE CODES
		;N.B.: MLO MUST BE AT RIGHT-HAND END OF WORD - CODE DEPENDS

MEMPNT:	BLOCK TSYSM	;RH USED FOR CIRC MEM USE PNTR IF USER MEM
			;LH FOR DISK ADDRESS CAME FROM OR GOING TO
		 	 ;MEMPNT HAS BLOCK NUMBER
		 	 ;DISK NUMBER COMES FROM CHANNEL LINKED TO
	;CIRCULAR PAGE LINK FORM
	;2.9=0
	;1.1-1.8 PAGE #
	;2.8-1.9 USER #
	;2.9=1
	;2.8=0 2.7-1.1 LINK TO MMP TABLE
	;2.8=1 2.7-1.1 LINK TO MEM PNT TABLE
	;EXCEPT 2.9-1.1=777777 => ABSOLUTE PAGE, NOT LINKED

MMSWP:	BLOCK TSYSM	;IF USER MEM, HAS NUMBER OF PAGE TABLE WORDS
			; WHICH POINT AT THIS PAGE.  LH IS NUMBER OF EXEC
			; PAGES, RH IS NUMBER OF USER PAGES.  NOTE THAT THE
			; NUMBER OF UPGCP ENTRIES COULD BE MORE, FOR VARIOUS
			; REASONS, E.G. CIRPSW LOCKED WHEN PAGE SWAPPED IN,
			; OR A USER WAS SWAPPED OUT.
			;IFN SWPWSP, RH(MMSWP) IS USED AS NUMBER OF SHARERS.

EMEMTL==.-1	;END FOR GETSYS (MEMORY)

MMPRTC:	0	;C AT MMPRTN, FOR DEBUGGING

MMPFS:	0	;FREE-LIST OF MMP ENTRIES.  VALUE IS ADDRESS. (FORMERLY WAS IDX).

MMPFS2:	0	;LIST OF MMPS THAT NEED TO HAVE TUT SOS'ED BEFORE THEY CAN BE FREED.
		;TUT COULDN'T BE SOS'ED AT P.I. LEVEL BECAUSE IT WAS LOCKED.
		;THESE MMPS MAY ALSO NEED TO BE REMOVED FROM THE SHAREABLE
		;PAGE TABLE, WHICH REQUIRES CIRPSW.

MMPCNT:	0	;# OF MMP ENTRIES IN USE.

MMPFR:	NMMP*1000	;MAX POSSIBLE # MMP ENTRIES, MINUS # IN USE OR COMMITTED.

;MMP TABLE - TWO WDS PER ENTRY
MMPPUB==400000	;WD1 4.9 INDICATES A PUBLIC PAGE IF ON (ANYONE CAN ATTACH TO WRITE)
MMPOUT==200000	;4.8 => PAGE IS SWAPPED OUT OR ON WAY OUT.
MMPTMP==100000	;4.7 => IN TRANSIT (ON WAY IN OR ON WAY OUT).
MMPWOD==40000	;4.6 => THIS PAGE HAS BEEN WRITTEN ON DISK AT LEAST ONCE
MMPISW==20000	;4.5 PAGE ON INITIAL SWAPIN, BEING COPIED SO SWAP OUT TO DIFF PLACE
MMPWRT==10000	;4.4 HAS BEEN WRITTEN SINCE LAST DISK WRITE BY USER WHO HAS DETACHED THIS PAGE
MMPGON==4000	;4.3 FILE PAGE BEING WRITTEN OUT AFTER
		 ;DELETED FROM ALL MAPS (MMP ENTRY WILL SOON GO AWAY.)
MMPBAD==2000	;4.2 PAGE GOT PAR ERR SINCE LAST TIME SWAPPED OUT OR IN.
MMPLOK==1000	;4.1 => PAGE MAY NOT BE SWAPPED OUT.
MMPSLO==400	;3.9 => PAGE SHOULD GO IN SLOW MEMORY.
MMPSHR==200	;3.8 MMP ENTRY IS IN SHAREABLE PAGE HASH TABLE
MMPPGA==100	;3.7 BEING SWAPPED IN BY PAGE-AHEAD.  DON'T PUT IN USER MAPS; WAIT FOR FAULTS.
MMPPGB==40	;3.6 BEING SWAPPED OUT BY PAGE-BEHIND.
$MMPUN==220300	;3.1-3.3 UNIT NUMBER (GOES WITH DISK ADDR IN WD2 LH)
	;WD1 RH CIRC MEM USE PNTR
	;WD2 LH READ DISK ADR OR 0
	;WD2 RH THREAD FOR SHAREABLE PAGE HASH TABLE

MMPNP:	0	;#MMP PGS ACTUALLY IN USE
MMPMX:	0	;HIGHEST VALID MMP INDEX (MMPNP*2000)

MMMPG:	BLOCK NMMP	;BLOCK NOS OF BLOCKS ACTUALLY USED

;SHAREABLE PAGE HASH TABLE
;MMP ENTRIES THAT ARE SHARED WITH FILES ARE LISTED HERE TO SAVE TIME AT NCORQ2
;SIMPLE REMAINDER HASH ON UNIT#,,DISK ADDRESS,
;BUCKETS THREADED THROUGH RH(MMPE+1)

SHRHSL==31.	;NUMBER OF BUCKETS
SHRHSH:	BLOCK SHRHSL

;"LOOSE" PAGES (NOT USED BY ANY USER, BUT NOT YET SWAPPED OUT.)
;MMP ENTRY GOES AWAY WHEN SWAPPED OUT, OR GETS PUT BACK INTO SERVICE AT NCORQ3.
NLOOSP:	0	;NUMBER OF LOOSE PAGES
FLOOSP:	0	;HEAD OF LIST.  THREADED THROUGH MLO IN MEMBLT.
LLOOSP:	0	;TAIL OF LIST.  ADD AT TAIL, SWAPPER REMOVES FROM HEAD.

BBLK
MMPEAD:	REPEAT NMMP,	CONC MMP,\.RPCNT,*2000+400000	;EXEC ADR
MMPPPP:	REPEAT NMMP,	CONC .MMP,\.RPCNT,+EXEUMP	;PNTR TO EXEC PC MP
USEMDM:	DIRMAP		;NON-ZERO => USE MEDIUM MEMORY.
			;DON'T CHANGE AFTER SYSTEM STARTUP

SUBTTL 200-WORD I/O BUFFER ROUTINES

;SYS CHANNEL ASSIGN
;  77=>FREE
; 0 - NUTIC+NUTOC-1 => UTAPE CHNL
;NUTIC+NUTOC (=NFCLC-1) =>UTAPE FILE DIR
;NFCLS-NFCLC+NCLCH-1 (=NFNETC-1) => CORE LINK
;NFNETC-NNETCH => NETWORK

IOBCNS:	MOVEI A,IOBFP-IOBFT
IOBC1:	MOVE E,A
	LDB A,[IOLO,,IOBFT(A)]
	CAIN A,377
	 JRST 4,.	;IOBFT POINTERS FOULED UP

IOBC2:	LDB B,[420200,,IOBFT(A)]
	JUMPN B,IOBC1
	LDB B,[IOLO,,IOBFT(A)]
	DPB B,[IOLO,,IOBFT(E)]
	SOS IOBFC
	POPJ P,


IOBR:	MOVE B,IOBFP	;RETURN IOBFT WORD
	CLEARM IOBFT(A)
	DPB B,[IOLO,,IOBFT(A)]
	MOVEM A,IOBFP
	MOVEI B,77
	DPB B,[IOCH,,IOBFT(A)]
	AOS IOBFC
	POPJ P,

IUTCONS:		;ALLOCATE 200 WORD BUFFER
IUTCO1:	PI2SAF
	SKIPG UTTBF	;CLOBBERS A B E TT, RETURNS IOBFT INDEX IN A
	 JRST IUTC1	;NO UTAPE BUFFERS FREE
	MOVEI E,UTFS-IOBFT
	MOVE A,UTFS	;CHNL NO IN D
IUTC3:	CAIN A,377
	 JRST IUTC1
	LDB B,[420200,,IOBFT(A)]
	JUMPN B,IUTC2
	LDB B,[IOCH,,IOBFT(A)]
	CAIE B,77
	 JRST 4,.	;BUFFER BEING ALLOCATED ISN'T FREE.
	LDB B,[IOLO,,IOBFT(A)]
	DPB B,[IOLO,,IOBFT(E)]
	DPB D,[IOCH,,IOBFT(A)]
	SOS UTTBF
	JRST POPJ1

IUTC2:	MOVE E,A
	LDB A,[IOLO,,IOBFT(A)]
	JRST IUTC3

IUTC1:	PUSHJ P,UIMRQ
	 POPJ P,
	PUSHJ P,UTMGB
	JRST IUTCO1

IBRTN:	PI2SAF
	PUSH P,B	;FREE 200 WORD BUFFER (SEE BRTN)
;	LDB B,[IOCH,,IOBFT(A)]
;	CAIN B,77
;	 JRST 4,.	;RETURNING A BUFFER THAT'S FREE?
	MOVE B,UTFS
	DPB B,[IOLO,,IOBFT(A)]
	MOVEM A,UTFS
	MOVEI B,77
	DPB B,[IOCH,,IOBFT(A)]
	LDB B,[IOSA,,IOBFT(A)]
	SKIPN B
	 JRST 4,.
	AOS UTTBF
	JRST POPBJ

UTMGB:	PUSH P,J	;GOBBLE MEM BLK IN A FOR UTAPE BUFFER
	PUSH P,R
	PUSH P,Q
	PUSH P,B
	PUSH P,E
	MOVEI B,MUIOB
	DPB B,[MUR,,MEMBLT(A)]
	MOVE J,A
	LSH A,10.-6.	;CONV TO BUF SA
	MOVE TT,A	;INCR TO NEXT BUF ADR
	MOVEI R,8
	ADDM R,UTTLB	;UTTBF AOSED AT IBRTN
	MOVNI Q,1
UTMG1:	PUSHJ P,IOBCNS
	DPB TT,[IOSA,,IOBFT(A)]
	JUMPL Q,UTMG2
	DPB A,[IOLC,,IOBFT(Q)]
UTMG3:	MOVE Q,A
	PUSHJ P,IBRTN
	ADDI TT,2
	SOJG R,UTMG1
	MOVEI TT,377
	DPB TT,[IOLC,,IOBFT(A)]
	POP P,E
	POP P,B
	POP P,Q
	POP P,R
	POP P,J
FSCMP:				;RECOMPUTE UTAPE BUFFER FAIR SHARE
IFN NUNITS,[
	MOVE A,UTTLB
	PUSH P,A+1
	IDIV A,NUTCA
	POP P,A+1
	MOVEM A,UPCHFS
]
	POPJ P,

UTMG2:	DPB A,[MNUMB,,MEMBLT(J)]
	JRST UTMG3

BRTN:	CONO PI,UTCOFF		;RETURN A 200-WD BUFFER
	PUSHJ P,IBRTN
	JRST UTCONJ
